Cream of the Crop 20/Cream of the Crop 20 (Terry Blount) (1996).iso/program/abc9511.zip/ABC9511.CDE

Text File | 1995-10-28 | 964KB | 1 lines

Unknown Author(s)              CALCULATOR FUNCTIONS           CALCULATOR,FUNCTIONS           Unknown Date           QB, QBasic, PDS        205  3990     CALC.BAS    DECLARE FUNCTION Calc# (A$)πDECLARE SUB Arith (OO$, R#, H#)πDECLARE SUB GetExp (R#)πDECLARE SUB GetToken ()πDECLARE SUB Level1 (R#)πDECLARE SUB Level2 (R#)πDECLARE SUB Level3 (R#)πDECLARE SUB Level4 (R#)πDECLARE SUB Level5 (R#)πDECLARE SUB Level6 (R#)πDECLARE SUB Ptv (R#)πDECLARE SUB Un (OO$, R#)ππDEFINT A-ZππCOMMON SHARED Token$, TokenType#, p#, Arg$ππ'IF INSTR(PRG$, "+-*/<>()=&_?") THENπ'REPLACE "+" WITH " + " IN PRG$π'REPLACE "-" WITH " - " IN PRG$π'REPLACE "*" WITH " * " IN PRG$π''REPLACE "\" WITH " \ " IN PRG$π'REPLACE "/" WITH " / " IN PRG$π''REPLACE "^" WITH " ^ " IN PRG$π'REPLACE "<" WITH " < " IN PRG$π'REPLACE ">" WITH " > " IN PRG$π'REPLACE "(" WITH " ( " IN PRG$π'REPLACE ")" WITH " ) " IN PRG$π'REPLACE "=" WITH " = " IN PRG$π'REPLACE "&" WITH " & " IN PRG$π'REPLACE "?" WITH "" IN PRG$π'REPLACE "_"+CHR$(13,10) WITH " " IN PRG$π'END IFππPRINTπPRINT "((1 + 2) + (3 - 5) * 4 )/ 6="πPRINT Calc("((1+2)+(3-5)*4)/6")πPRINT ((1 + 2) + (3 - 5) * 4) / 6#πPRINTππDEFDBL A-ZπSUB Arith (OO$, R, H)ππ  IF OO$ = "-" THEN R = (R - H)π  IF OO$ = "+" THEN R = (R + H)π  IF OO$ = "*" THEN R = (R * H)π  IF OO$ = "/" THEN R = (R / H)π  IF OO$ = "^" THEN R = (R ^ H)π  IF OO$ = "<" THEN R = (R < H)π  IF OO$ = ">" THEN R = (R > H)π  IF OO$ = "=" THEN R = (R = H)ππEND SUBππ' All of the following subroutines are necessary to perform the recursiveπ' descent parser.  CALC is the only callable routine, and must be passedπ' a string containing a valid math expression.π' An invalid expression, such as (2**4) or (1+2+3+) will result in aπ' SYNTAX ERROR message, printed on the screen by the sub PTV().  Mismatchedπ' parenthesis result in an error message displayed by sub LEVEL6().  Theseπ' error messages could be replaced with the ERROR nn statement, allowing yourπ' own error-handling routines to report the error.π'π' This routine supports boolean expressions (1>2) and unary operators (5*-1)πFUNCTION Calc (A$)ππ  R = 0π  p = 1π  IF A$ = "" THEN GOTO EndCalcSubπ  Arg$ = A$π  CALL GetExp(R)π  LET Calc = RππEndCalcSub:ππEND FUNCTIONππSUB GetExp (R)ππ  CALL GetTokenπ  CALL Level1(R)ππEND SUBππSUB GetTokenππ  Token$ = ""ππ  WHILE MID$(Arg$, p, 1) = " "π    p = p + 1π  WENDππ  IF INSTR("-+*/^()<>=", MID$(Arg$, p, 1)) THENπ    TokenType = 1π    Token$ = MID$(Arg$, p, 1)π    p = p + 1π    EXIT SUBπ  END IFππ    IF INSTR("01234567890.", MID$(Arg$, p, 1)) THENπ      WHILE INSTR(" -+*/^()<>=", MID$(Arg$, p, 1)) = 0π        Token$ = Token$ + MID$(Arg$, p, 1)π        p = p + 1π      WENDπ      TokenType = 2π    END IFππEND SUBππSUB Level1 (R)ππ  CALL Level2(R): OO$ = Token$π  WHILE OO$ = "<" OR OO$ = ">" OR OO$ = "="π    CALL GetTokenπ    CALL Level2(H)π    CALL Arith(OO$, R, H)π    OO$ = Token$π  WENDππEND SUBππSUB Level2 (R)ππ  CALL Level3(R)π  OO$ = Token$π  WHILE OO$ = "+" OR OO$ = "-"π    CALL GetTokenπ    CALL Level3(H)π    CALL Arith(OO$, R, H)π    OO$ = Token$π  WENDππEND SUBππSUB Level3 (R)ππ  CALL Level4(R)π  OO$ = Token$π  WHILE OO$ = "*" OR OO$ = "/"π    CALL GetTokenπ    CALL Level4(H)π    CALL Arith(OO$, R, H)π    OO$ = Token$π  WENDππEND SUBππSUB Level4 (R)ππ  CALL Level5(R)π  IF Token$ = "^" THENπ    CALL GetTokenπ    CALL Level4(H)π    CALL Arith("^", R, H)π  END IFππEND SUBππSUB Level5 (R)ππ  OO$ = ""π  IF TokenType = 1 AND (Token$ = "+" OR Token$ = "-") THENπ    OO$ = Token$π    CALL GetTokenπ  END IFππ  CALL Level6(R)π  IF OO$ <> "" THEN CALL Un(OO$, R)ππEND SUBππSUB Level6 (R)ππ  IF Token$ = "(" AND TokenType = 1 THEN GOTO Eddy:π  CALL Ptv(R)π  EXIT SUBππEddy:π  CALL GetTokenπ  CALL Level1(R)π  IF Token$ <> ")" THEN ERROR 102π  CALL GetTokenππEND SUBππSUB Ptv (R)ππ  IF TokenType = 2 THENπ    R = VAL(Token$)π    CALL GetTokenπ    EXIT SUBπ  END IFππ  BEEPπ  ERROR 101π  ENDππEND SUBππSUB Un (OO$, R)ππ  IF OO$ = "-" THEN R = -RππEND SUBππUnknown Author(s)              METRIC CONVERTER               METRIC,CONVERTER               Unknown Date           QB, QBasic, PDS        1047 18675    METRIC.BAS  DECLARE SUB Pause (a!)πDECLARE SUB Frame (left%, Right%, top%, bottom%)πDECLARE SUB Stars (co!, qwe$)πDECLARE SUB Chart (starter, stoper, inc, number)πDECLARE SUB CtoI ()πDECLARE SUB KtoF ()πDECLARE SUB FtoK ()πDECLARE SUB KtoC ()πDECLARE SUB CtoK ()πDECLARE SUB KtoP ()πDECLARE SUB PtoK ()πDECLARE SUB FtoC ()πDECLARE SUB CtoF ()πDECLARE SUB ItoC ()πDECLARE FUNCTION CM! (s!)πDECLARE FUNCTION In! (a!)πDECLARE FUNCTION CelK! (u!)πDECLARE FUNCTION KelC! (l!)πDECLARE FUNCTION KelF! (i!)πDECLARE FUNCTION FahrK! (r!)πDECLARE FUNCTION Kg! (o!)πDECLARE FUNCTION Lbs! (n!)πDECLARE FUNCTION Fahr! (a!)πDECLARE FUNCTION Celsius! (s!)ππCOMMON SHARED rouπCOLOR 13πBEEPπON KEY(31) GOSUB F12πKEY(31) ONπCLSπWIDTH 80, 50πr% = 5πc% = 37πFrame 23, 56, 1, 5πCOLOR 10πLOCATE 2, 24πPRINT "Welcome to the metric converter:"πCOLOR 15πLOCATE 3, 36πPRINT "Convert"πCOLOR 10πLOCATE 4, 31ππDOπ π  rou = 0π  PRINT "Any key to continue"π π  DOπ  LOOP UNTIL INKEY$ <> ""π π  CLSπ  COLOR 12π  LOCATE r% - 1, c%π  PRINT "M E N U"π  COLOR 13π  Frame 27, 53, r% + 1, 28π  LOCATE r% + 2, c% - 9π  COLOR 14π  PRINT "1";π  COLOR 9π  PRINT ".  Fahrenheit to Celsius"π  LOCATE r% + 4, c% - 9π  COLOR 14π  PRINT "2";π  COLOR 9π  PRINT ".  Celsius to Fahrenheit"π  LOCATE r% + 6, c% - 9π  COLOR 14π  PRINT "3";π  COLOR 9π  PRINT ".  Inches to Centimeters"π  LOCATE r% + 8, c% - 9π  COLOR 14π  PRINT "4";π  COLOR 9π  PRINT ".  Centimeters to Inches"π  LOCATE r% + 10, c% - 9π  COLOR 14π  PRINT "5";π  COLOR 9π  PRINT ".  Kilogram to Pounds"π  LOCATE r% + 12, c% - 9π  COLOR 14π  PRINT "6";π  COLOR 9π  PRINT ".  Pounds to Kilograms"π  LOCATE r% + 14, c% - 9π  COLOR 14π  PRINT "7";π  COLOR 9π  PRINT ".  Kelvien to Celsius"π  LOCATE r% + 16, c% - 9π  COLOR 14π  PRINT "8";π  COLOR 9π  PRINT ".  Celsius to Kelvien"π  LOCATE r% + 18, c% - 9π  COLOR 14π  PRINT "9";π  COLOR 9π  PRINT ".  Kelvien to Fahrenheit"π  LOCATE r% + 20, c% - 9π  COLOR 14π  PRINT "0";π  COLOR 9π  PRINT ".  Fahrenheit to Kelvien"π  LOCATE r% + 22, c% - 9π  COLOR 14π  PRINT "X";π  COLOR 9π  PRINT ".  Exit"π  COLOR 11π  LOCATE 49, 26π  PRINT "[Esc] and [F12] also exit."π  LOCATE r% + 25, c% - 10π  PRINT "Please enter your selection ";π  COLOR 27π  PRINT "_"π  COLOR 11π  CALL Stars(2, qwe$)π  a$ = qwe$π  IF a$ = CHR$(27) THEN EXIT DOπ  COLOR 15π  LOCATE r% + 25, c% + 19π  PRINT a$π  COLOR 13π  SLEEP 1π  w$ = UCASE$(a$)ππ  SELECT CASE w$π    CASE "1"π      rou = 1π      FtoCπ    CASE "2"π      rou = 2π      CtoFπ    CASE "3"π      rou = 3π      ItoCπ    CASE "4"π      rou = 4π      CtoIπ    CASE "5"π      rou = 5π      KtoPπ    CASE "6"π      rou = 6π      PtoKπ    CASE "7"π      rou = 7π      KtoCπ    CASE "8"π      rou = 8π      CtoKπ    CASE "9"π      rou = 9π      KtoFπ    CASE "0"π      rou = 0π      FtoKπ    CASE "X"π      GOSUB F12:π    CASE ELSEπ      LOCATE , 22π      PRINT "Please press only a key from [1 to 7]"π      LOCATE , 31π  END SELECTπ  π  COLOR 13π  BEEPπLOOPππF12:π  BEEPπ  COLOR 11π  FOR q = 29 TO 37π    LOCATE qπ    PRINT SPACE$(80)π  NEXT qπ  Frame 28, 52, 30, 36π  COLOR 10π  LOCATE 32, 31π  PRINT "Thank-you for using"π  COLOR 15π  LOCATE 34, 37π  PRINT "Convert"π  COLOR 7π  ENDππF9:π  COLOR 10π  Pause 0π  COLOR 11π  RETURNππFUNCTION CelK (o)ππ  CelK = o - 273.15ππEND FUNCTIONππFUNCTION Celsius (m)ππ  Celsius = 5 / 9 * (m - 32)ππEND FUNCTIONππSUB Chart (st, en, inc, r)ππON KEY(9) GOSUB F9:πKEY(9) ONπCLSπCOLOR 12πFrame 23, 56, 1, 6πCOLOR 10πLOCATE 2, 33πPRINT "Converter Chart"πPRINTπLOCATE , 24πCOLOR 13πPRINT "Press [F9] once to pause listing"πLOCATE , 27πPRINT "Then hit any key to resume"πPRINTπPRINTπCOLOR 15ππSELECT CASE rπ  CASE 1π    PRINT "  Fahrenheit", "             Celsius"π    PRINTπ    VIEW PRINT 10 TO 50π    COLOR 11π    FOR q = st TO en STEP incπ      PRINT USING "######.## °F  ==IS==  ######.## °C"; q; Celsius(q)π      ' WAIT &H20, 1π      ' WAIT &H20, 1π    NEXT qπ    PRINTπ  CASE 2π    PRINT "     Celsius", "          Fahrenheit"π    PRINTπ    VIEW PRINT 10 TO 50π    COLOR 11π    FOR q = st TO en STEP incπ      PRINT USING "######.## °C  ==IS==  ######.## °F"; q; Fahr(q)π      ' WAIT &H20, 1π      ' WAIT &H20, 1π    NEXT qπ    PRINTπ  CASE 3π    PRINT "     Inches", "        Centimeters"π    PRINTπ    VIEW PRINT 10 TO 50π    COLOR 11π    FOR q = st TO en STEP incπ      PRINT USING "######.## &  ==IS==  ######.## cm"; q; CHR$(34); CM(q)π      ' WAIT &H20, 1π      ' WAIT &H20, 1π    NEXT qπ    PRINTπ  CASE 4π    PRINT " Centimeters", "             Inches"π    PRINTπ    VIEW PRINT 10 TO 50π    COLOR 11π    FOR q = st TO en STEP incπ      PRINT USING "######.## cm  ==IS==  ######.## &"; q; In(q); CHR$(34)π      ' WAIT &H20, 1π      ' WAIT &H20, 1π    NEXT qπ    PRINTπ  CASE 5π    PRINT "   Kilograms", "               Pounds"π    PRINTπ    VIEW PRINT 10 TO 50π    COLOR 11π    FOR q = st TO en STEP incπ      PRINT USING "######.## kg  ==IS==  ######.## lbs"; q; Lbs(q)π      ' WAIT &H20, 1π      ' WAIT &H20, 1π    NEXT qπ    PRINTπ  CASE 6π    PRINT "       Pounds", "            Kilograms"π    PRINTπ    VIEW PRINT 10 TO 50π    COLOR 11π    FOR q = st TO en STEP incπ      PRINT USING "######.## lbs  ==IS==  ######.## kg"; q; Kg(q)π      ' WAIT &H20, 1π      ' WAIT &H20, 1π    NEXT qπ    PRINTπ  CASE 7π    PRINT "    Kelvien", "            Celsius"π    PRINTπ    VIEW PRINT 10 TO 50π    COLOR 11π    FOR q = st TO en STEP incπ      PRINT USING "######.## K  ==IS==  ######.## °C"; q; CelK(q)π      ' WAIT &H20, 1π      ' WAIT &H20, 1π    NEXT qπ    PRINTπ  CASE 8π    PRINT "     Celsius", "            Kelvien"π    PRINTπ    VIEW PRINT 10 TO 50π    COLOR 11π    FOR q = st TO en STEP incπ      PRINT USING "######.## °C  ==IS==  ######.## K"; q; KelC(q)π      ' WAIT &H20, 1π      ' WAIT &H20, 1π    NEXT qπ    PRINTπ  CASE 9π    PRINT "    Kelvien", "         Fahrenheit"π    PRINTπ    VIEW PRINT 10 TO 50π    COLOR 11π    FOR q = st TO en STEP incπ      PRINT USING "######.## K  ==IS==  ######.## °F"; q; FahrK(q)π      ' WAIT &H20, 1π      ' WAIT &H20, 1π    NEXT qπ    PRINTπ  CASE 0π    PRINT "  Fahrenheit", "            Kelvien"π    PRINTπ    VIEW PRINT 10 TO 50π    COLOR 11π    FOR q = st TO en STEP incπ      PRINT USING "######.## °F  ==IS==  ######.## K"; q; KelF(q)π      ' WAIT &H20, 1π      ' WAIT &H20, 1π    NEXT qπ    PRINTπEND SELECTππPause 2πVIEW PRINTπCLSπKEY(9) OFFππEND SUBππFUNCTION CM (i)ππ  CM = i * 2.54ππEND FUNCTIONππSUB CtoFππWHILE INKEY$ <> ""πWENDπCLSππDOππ  DOπ    COLOR 13π    PRINT "Type 'end' to exit"π    PRINT "Type 'chart' to make a chart of temperatures"π    PRINTπ    COLOR 11π    INPUT "Enter Celsius (°C) temperature:->", a$π π    IF UCASE$(a$) = "END" THENπ      PRINTπ      EXIT DOπ    END IFππ    IF UCASE$(a$) = "CHART" THENπ      PRINTπ      PRINTπ      COLOR 10π      INPUT "Enter Starting temperature (°C):->", stπ      PRINTπ      INPUT "Enter Ending temperature (°C):->", enπ      PRINTπ      INPUT "Increment:->", incπ      PRINTππ      IF en < st THENπ        PRINT "Ending temperature MUST be greater than Starting temperature!"π        PRINTπ        SLEEP 3π        COLOR 11π        EXIT DOπ      END IFπ    π      COLOR 11π      roun = rouπ      Chart st, en, inc, rounπ      PRINTπ      EXIT DOπ    END IFπ π    w = VAL(a$)π    PRINT USING "That temperature in Fahrenheit is_->######.## °F"; Fahr(w)π    COLOR 13π    PRINTππ  LOOPππLOOP WHILE UCASE$(a$) <> "END"ππEND SUBππSUB CtoIπ πWHILE INKEY$ <> ""πWENDπCLSππDOππ  DOπ    COLOR 13π    PRINT "Type 'end' to exit"π    PRINT "Type 'chart' to make a chart of lengths"π    PRINTπ    COLOR 11π    INPUT "Enter length in Centimeters:->", a$π    IF UCASE$(a$) = "END" THENπ      PRINTπ      EXIT DOπ    END IFππ    IF UCASE$(a$) = "CHART" THENπ      PRINTπ      PRINTπ      COLOR 10π      INPUT "Enter Starting length (cm):->", stπ      PRINTπ      INPUT "Enter Ending length (cm):->", enπ      PRINTπ      INPUT "Increment:->", incπ      PRINTππ      IF en < st THENπ        PRINT "Ending length MUST be greater than Starting length!"π        PRINTπ        SLEEP 3π        COLOR 11π        EXIT DOπ      END IFπ   π      COLOR 11π      roun = rouπ      Chart st, en, inc, rounπ      PRINTπ      EXIT DOπ    END IFππ    q = VAL(a$)π    PRINT USING "That length in Inches is_->######.## &"; In(q); CHR$(34)π    COLOR 13π    PRINTππ  LOOPππLOOP WHILE UCASE$(a$) <> "END"ππEND SUBππSUB CtoKππWHILE INKEY$ <> ""πWENDπCLSππDOππ  DOπ    COLOR 13π    PRINT "Type 'end' to exit"π    PRINT "Type 'chart' to make a chart of temperatures"π    PRINTπ    COLOR 11π    INPUT "Enter Celsius (°C) temperature:->", a$ππ    IF UCASE$(a$) = "END" THENπ      PRINTπ      EXIT DOπ    END IFππ    IF UCASE$(a$) = "CHART" THENπ      PRINTπ      PRINTπ      COLOR 10π      INPUT "Enter Starting temperature (°C):->", stπ      PRINTπ      INPUT "Enter Ending temperature (°C):->", enπ      PRINTπ      INPUT "Increment:->", incπ      PRINTππ      IF en < st THENπ        PRINT "Ending temperature MUST be greater than Starting temperature!"π        PRINTπ        SLEEP 3π        COLOR 11π        EXIT DOπ      END IFπ  π      COLOR 11π      roun = rouπ      Chart st, en, inc, rounπ      PRINTπ      EXIT DOπ    END IFππ    s = VAL(a$)π    PRINT USING "That temperature in Kelvien is_->######.## K"; KelC(s)π    COLOR 13π    PRINTππ  LOOPππLOOP WHILE UCASE$(a$) <> "END"ππEND SUBππFUNCTION Fahr (c)ππ  Fahr = (c * 9 / 5) + 32ππEND FUNCTIONππFUNCTION FahrK (k)ππ  FahrK = ((k - 273.15) * 9 / 5) + 32ππEND FUNCTIONππSUB Frame (left%, Right%, top%, bottom%) STATICππhoriz% = Right% - left% - 1πhline$ = STRING$(horiz%, 205)ππFOR vert% = top% + 1 TO bottom% - 1π  LOCATE vert%, left%π  PRINT CHR$(186); SPC(horiz%); CHR$(186)πNEXT vert%ππLOCATE bottom%, left%πPRINT CHR$(200);πLOCATE bottom%, left% + 1πPRINT hline$;πLOCATE bottom%, Right%πPRINT CHR$(188);πLOCATE top%, left%πPRINT CHR$(201);πLOCATE top%, left% + 1πPRINT hline$πLOCATE top%, Right%πPRINT CHR$(187);ππEND SUBππSUB FtoCππWHILE INKEY$ <> ""πWENDπCLSππDOππ  DOπ    COLOR 13π    PRINT "Type 'end' to exit"π    PRINT "Type 'chart' to make a chart of temperatures"π    PRINTπ    COLOR 11π    INPUT "Enter Fahrenheit temperature:->", a$π    IF UCASE$(a$) = "END" THENπ      PRINTπ      EXIT DOπ    END IFππ    IF UCASE$(a$) = "CHART" THENπ      PRINTπ      PRINTπ      COLOR 10π      INPUT "Enter Starting temperature (°F):->", stπ      PRINTπ      INPUT "Enter Ending temperature (°F):->", enπ      PRINTπ      INPUT "Increment:->", incπ      PRINTππ      IF en < st THENπ        PRINT "Ending temperature MUST be greater than Starting temperature!"π        PRINTπ        SLEEP 3π        COLOR 11π        EXIT DOπ      END IFπ   π      COLOR 11π      roun = rouπ      Chart st, en, inc, rounπ      PRINTπ      EXIT DOπ    END IFππ    j = VAL(a$)π    PRINT USING "That temperature in Celsius is_->######.## °C"; Celsius(j)π    COLOR 13π    PRINTππ  LOOPππLOOP WHILE UCASE$(a$) <> "END"ππEND SUBππSUB FtoKππWHILE INKEY$ <> ""πWENDπCLSππDOππ  DOπ    COLOR 13π    PRINT "Type 'end' to exit"π    PRINT "Type 'chart' to make a chart of temperatures"π    PRINTπ    COLOR 11π    INPUT "Enter Fahrenheit (°F) temperature:->", a$ππ    IF UCASE$(a$) = "END" THENπ      PRINTπ      EXIT DOπ    END IFππ    IF UCASE$(a$) = "CHART" THENπ      PRINTπ      PRINTπ      COLOR 10π      INPUT "Enter Starting temperature (°F):->", stπ      PRINTπ      INPUT "Enter Ending temperature (°F):->", enπ      PRINTπ      INPUT "Increment:->", incπ      PRINTππ      IF en < st THENπ        PRINT "Ending temperature MUST be greater than Starting temperature!"π        PRINTπ        SLEEP 3π        COLOR 11π        EXIT DOπ      END IFπ  π      COLOR 11π      roun = rouπ      Chart st, en, inc, rounπ      PRINTπ      EXIT DOπ    END IFππ    h = VAL(a$)π    PRINT USING "That temperature in Kelvien is_->######.## K"; KelF(h)π    COLOR 13π    PRINTππ  LOOPππLOOP WHILE UCASE$(a$) <> "END"ππEND SUBππFUNCTION In (c)π π  In = c / 2.54ππEND FUNCTIONππSUB ItoCππWHILE INKEY$ <> ""πWENDπCLSππDOππ  DOπ    COLOR 13π    PRINT "Type 'end' to exit"π    PRINT "Type 'chart' to make a chart of lengths"π    PRINTπ    COLOR 11π    INPUT "Enter length in Inches:->", a$π    IF UCASE$(a$) = "END" THENπ      PRINTπ      EXIT DOπ    END IFππ    IF UCASE$(a$) = "CHART" THENπ      PRINTπ      PRINTπ      COLOR 10π      INPUT "Enter Starting length (Inches):->", stπ      PRINTπ      INPUT "Enter Ending length (Inches):->", enπ      PRINTπ      INPUT "Increment:->", incπ      PRINTππ      IF en < st THENπ        PRINT "Ending length MUST be greater than Starting length!"π        PRINTπ        SLEEP 3π        COLOR 11π        EXIT DOπ      END IFπ  π      COLOR 11π      roun = rouπ      Chart st, en, inc, rounπ      PRINTπ      EXIT DOπ    END IFππ    i = VAL(a$)π    PRINT USING "That length in Centimeters is_->######.## &"; CM(i)π    COLOR 13π    PRINTππ  LOOPππLOOP WHILE UCASE$(a$) <> "END"ππEND SUBππFUNCTION KelC (c)ππ  KelC = c + 273.15ππEND FUNCTIONππFUNCTION KelF (f)ππ  KelF = (5 / 9 * (f - 32)) + 273.15ππEND FUNCTIONππFUNCTION Kg (p)π π  Kg = p / 2.2ππEND FUNCTIONππSUB KtoCππWHILE INKEY$ <> ""πWENDπCLSππDOππ  DOπ    COLOR 13π    PRINT "Type 'end' to exit"π    PRINT "Type 'chart' to make a chart of temperatures"π    PRINTπ    COLOR 11π    INPUT "Enter Kelvien (K) temperature:->", a$ππ    IF UCASE$(a$) = "END" THENπ      PRINTπ      EXIT DOπ    END IFππ    IF UCASE$(a$) = "CHART" THENπ      PRINTπ      PRINTπ      COLOR 10π      INPUT "Enter Starting temperature (K):->", stπ      PRINTπ      INPUT "Enter Ending temperature (K):->", enπ      PRINTπ      INPUT "Increment:->", incπ      PRINTππ      IF en < st THENπ        PRINT "Ending temperature MUST be greater than Starting temperature!"π        PRINTπ        SLEEP 3π        COLOR 11π        EXIT DOπ      END IFπ   π      COLOR 11π      roun = rouπ      Chart st, en, inc, rounπ      PRINTπ      EXIT DOπ    END IFππ    k = VAL(a$)π    PRINT USING "That temperature in Celsius is_->######.## °C"; CelK(k)π    COLOR 13π    PRINTππ  LOOPππLOOP WHILE UCASE$(a$) <> "END"ππEND SUBππSUB KtoFππWHILE INKEY$ <> ""πWENDπCLSππDOππ  DOπ    COLOR 13π    PRINT "Type 'end' to exit"π    PRINT "Type 'chart' to make a chart of temperatures"π    PRINTπ    COLOR 11π    INPUT "Enter Kelvien (K) temperature:->", a$ππ    IF UCASE$(a$) = "END" THENπ      PRINTπ      EXIT DOπ    END IFππ    IF UCASE$(a$) = "CHART" THENπ      PRINTπ      PRINTπ      COLOR 10π      INPUT "Enter Starting temperature (K):->", stπ      PRINTπ      INPUT "Enter Ending temperature (K):->", enπ      PRINTπ      INPUT "Increment:->", incπ      PRINTππ      IF en < st THENπ        PRINT "Ending temperature MUST be greater than Starting temperature!"π        PRINTπ        SLEEP 3π        COLOR 11π        EXIT DOπ      END IFπ   π      COLOR 11π      roun = rouπ      Chart st, en, inc, rounπ      PRINTπ      EXIT DOπ    END IFππ    k = VAL(a$)π    PRINT USING "That temperature in Fahrenheit is_->######.## °F"; FahrK(k)π    COLOR 13π    PRINTππ  LOOPππLOOP WHILE UCASE$(a$) <> "END"ππEND SUBππSUB KtoPππWHILE INKEY$ <> ""πWENDπCLSππDOππ  DOπ    COLOR 13π    PRINT "Type 'end' to exit"π    PRINT "Type 'chart' to make a chart of weights"π    PRINTπ    COLOR 11π    INPUT "Enter weight in Kilograms:->", a$π    IF UCASE$(a$) = "END" THENπ      PRINTπ      EXIT DOπ    END IFππ    IF UCASE$(a$) = "CHART" THENπ      PRINTπ      PRINTπ      COLOR 10π      INPUT "Enter Starting weight (kg):->", stπ      PRINTπ      INPUT "Enter Ending weight (kg):->", enπ      PRINTπ      INPUT "Increment:->", incπ      PRINTππ      IF en < st THENπ        PRINT "Ending weight MUST be greater than Starting weight!"π        PRINTπ        SLEEP 3π        COLOR 11π        EXIT DOπ      END IFπ  π      COLOR 11π      roun = rouπ      Chart st, en, inc, rounπ      PRINTπ      EXIT DOπ    END IFππ    k = VAL(a$)π    PRINT USING "That weight in Pounds is_->######.## lbs"; Lbs(k)π    COLOR 13π    PRINTππ  LOOPππLOOP WHILE UCASE$(a$) <> "END"ππEND SUBππFUNCTION Lbs (k)π π  Lbs = 2.2 * kππEND FUNCTIONππSUB Pause (a)ππPRINTπIF a = 0 THEN LOCATE , 27πPRINT "Press any key to continue."πPRINTππDOπLOOP WHILE INKEY$ = ""ππEND SUBππSUB PtoKππWHILE INKEY$ <> ""πWENDπCLSππDOππ  DOπ    COLOR 13π    PRINT "Type 'end' to exit"π    PRINT "Type 'chart' to make a chart of weights"π    PRINTπ    COLOR 11π    INPUT "Enter weight in Pounds:->", a$π    IF UCASE$(a$) = "END" THENπ      PRINTπ      EXIT DOπ    END IFππ    IF UCASE$(a$) = "CHART" THENπ      PRINTπ      PRINTπ      COLOR 10π      INPUT "Enter Starting weight (lbs):->", stπ      PRINTπ      INPUT "Enter Ending weight (lbs):->", enπ      PRINTπ      INPUT "Increment:->", incπ      PRINTππ      IF en < st THENπ        PRINT "Ending weight MUST be greater than Starting weight!"π        PRINTπ        SLEEP 3π        COLOR 11π        EXIT DOπ      END IFπ π      COLOR 11π      roun = rouπ      Chart st, en, inc, rounπ      PRINTπ      EXIT DOπ    END IFππ    p = VAL(a$)π    PRINT USING "That weight in Kilograms is_->######.## kg"; Kg(p)π    COLOR 13π    PRINTππ  LOOPππLOOP WHILE UCASE$(a$) <> "END"ππEND SUBππSUB Stars (co, qwe$)π πCOLOR coπa$ = "*    *    *    *    *    *    *    *    *    *    *    *    *    *    *    *    *    "ππWHILE INKEY$ <> ""πWENDππDOπ   π  FOR a% = 1 TO 5π    LOCATE 1, 1π    PRINT MID$(a$, a%, 80);π    LOCATE 33, 1π    PRINT MID$(a$, 6 - a%, 80);π    FOR b% = 2 TO 31π      c% = (a% + b%) MOD 5π     π      IF c% = 1 THENπ        LOCATE b%, 80π        PRINT "*";π        LOCATE 33 - b%, 1π        PRINT "*";π      ELSEπ        LOCATE b%, 80π        PRINT " ";π        LOCATE 33 - b%, 1π        PRINT " ";π      END IFππ    NEXT b%π  NEXT a%π  qwe$ = INKEY$ππLOOP WHILE qwe$ = ""ππEND SUBππEthan Winer                    VISUAL QUICK SORT              PC Magazine BASIC Techniques   Year of 1992           QB, QBasic, PDS        175  3726     VISQSORT.BAS'********* SEEQSORT.BAS - Quick Sort algorithm visual demonstrationππ'Copyright (c) 1992 Ethan WinerππDEFINT A-ZπDECLARE SUB SeeQSort (Array!())ππRANDOMIZE TIMER         'generate a new series each runππCONST MaxElements = 23  'the size of the text arrayπCONST Delay! = 1!       'pause delay, change to suitπCONST FG = 7            'the foreground colorπCONST BG = 1            'the background colorπCONST Hi = 15 + 16      'high-intensity flashingππDIM Array!(1 TO MaxElements)    'create an arrayπFOR X = 1 TO MaxElements        'fill with random numbersπ  Array!(X) = RND(1) * 500      'between 0 and 500πNEXTππCOLOR FG, BGπCLSπLOCATE 25, 1πPRINT "Press Escape to end the program early"; TAB(80);πCALL SeeQSort(Array!())ππSUB SeeQSort (Array!()) STATICππREDIM QStack(10)        'create a stack big enough for this exampleππFirst = LBOUND(Array!)  'initialize work variablesπLast = UBOUND(Array!)ππDOπ  DOπ    Temp! = Array!((Last + First) \ 2)  'seek midpointπ    I = Firstπ    J = Lastππ    DO     'reverse both < and > below to sort descendingπ      WHILE Array!(I) < Temp!π        I = I + 1π        GOSUB UpdateScreenπ        GOSUB Pauseπ      WENDπ      WHILE Array!(J) > Temp!π        J = J - 1π        GOSUB UpdateScreenπ        GOSUB Pauseπ      WENDπ      IF I > J THEN EXIT DOπ      IF I < J THENπ        LOCATE 1, 60π        COLOR BG, FGπ        PRINT " About to swap ";π        COLOR Hi, BGπ        LOCATE I, 39π        PRINT USING "####.## "; Array!(I);π        LOCATE J, 39π        PRINT USING "####.## "; Array!(J);π        COLOR FG, BGπ        GOSUB Pauseπ        SWAP Array!(I), Array!(J)π        GOSUB UpdateScreenπ        LOCATE 1, 60π        COLOR BG, FGπ        PRINT "    Swapped    ";π        GOSUB Pauseπ      END IFππ      I = I + 1π      J = J - 1π    LOOP WHILE I <= Jππ    IF I < Last THEN                    'Doneπ      LOCATE 1, 60π      COLOR BG, FGπ      PRINT " About to push ";π      GOSUB Pauseπ      QStack(StackPtr) = I              'Push Iπ      QStack(StackPtr + 1) = Last       'Push Lastπ      StackPtr = StackPtr + 2π      GOSUB UpdateScreenπ      LOCATE 1, 60π      COLOR BG, FGπ      PRINT "     Pushed    ";π      GOSUB Pauseπ    END IFππ    Last = Jπ  LOOP WHILE First < Lastππ  IF StackPtr = 0 THEN EXIT DOππ  LOCATE 1, 60π  COLOR BG, FGπ  PRINT " About to pop ";π  GOSUB Pauseπ  StackPtr = StackPtr - 2π  First = QStack(StackPtr)              'Pop Firstπ  Last = QStack(StackPtr + 1)           'Pop Lastπ  GOSUB UpdateScreenπ  LOCATE 1, 60π  COLOR BG, FGπ  PRINT "    Popped    ";π  GOSUB PauseπLOOPππERASE QStack               'delete the stack arrayπCOLOR FG, BGπEXIT SUBππUpdateScreen:π  COLOR FG, BGπ  LOCATE 1, 60π  PRINT SPC(15);ππ  FOR X = 1 TO MaxElementsπ    LOCATE X, 24π    IF X = (Last + First) \ 2 THENπ      COLOR BG, FGπ      PRINT " Midpoint ==> "π      COLOR FG, BGπ    ELSEπ      PRINT SPC(14);π    END IFπ  π    LOCATE X, 1π    IF X = First THENπ      COLOR BG, FGπ      PRINT " First ==> "π      COLOR FG, BGπ    ELSEπ      PRINT SPC(11);π    END IFπ   π    LOCATE X, 13π    IF X = Last THENπ      COLOR BG, FGπ      PRINT " Last ==> "π      COLOR FG, BGπ    ELSEπ      PRINT SPC(11);π    END IFπππ    LOCATE X, 39π    PRINT USING "####.## "; Array!(X);π    PRINT SPC(17);π    COLOR BG, FGπ    LOCATE X, 48ππ    IF X = I THENπ      PRINT " <== I "π    END IFπ    IF X = J THENπ      LOCATE X, 56π      PRINT " <== J "π    END IFππ    COLOR FG, BGπ  NEXTπRETURNπππPause:π  Start! = TIMERπ  DOπ  LOOP WHILE Start! + Delay! > TIMERππ  IF INKEY$ = CHR$(27) THEN ENDππ  RETURNππEND SUBπJamshid Khoshrangi             PB FORMULA SOLVER              [e-mail]             09-12-95 (00:00)       PB                     279  18354    ARDAF.BAS   '>>> Page 1 of ARDAF.ZIP begins here. TYPE:BINAA TLEN:13413πDEFINT A-Z:DIM SHARED K,S,B&,Z&:V1 'Created by PostIt! 7.1πSUB V1:OPEN "O",1,"ARDAF.ZIP",4^6:Z&=13413:?STRING$(50,177);πU"%up()%9%%%#-%2\S*DAT?YvdXm%%[2%%%1%%%%fw%ifkV%ZVSgRfxFL_:B?#Q/aπU"6E-Nw4B*C]e?INE(X<f'Gf=U+Rfeo%a\*MxI2mYUT<(1h>QA$_^Nu^w1u_YLw2VπU"DJ&MFqpa_TeIt+Lz1XhugN(NHd6;^f3<sjcp8zAcq.pgZrRHK\=2$&kZ_8lca5ZπU"sutXY:Y4d4=6xN=ErIAa/i(VrgcF'FpZBwwM7_QoHUBFMElt\lVWEN*&>zpCbXDπU"/3<fN)Ng'djS+Z<Dd-aPXQv]r6%f>4_A,ieF;aut_9pKw%c]tJJf0<GJO3-fdfSπU"Z'tf#GFID4_.ZN1rv&V7D:[Tu<2./5XZjVvqm,6R4Rt=lXT,XMi_DuTY8&R7+AWπU"BAXtcspZ6N?r*U?*H:<QQVZZvexKf'pJe)(fGu[#m-%pUV(tqRq]QY]Cj_Rj$63πU"emcB]<S)A&mqV',gP%eE5>ClL[F\(qOH^1kF.hqiWcC;a:n'Kg36[5GX5I0Ff'tπU"tPot3*^-)\v:,,>pS>k7-GUjWqH:;PlUo\7rtssF?[0'WWTsQ[l>vh[U>wO>'jOπU"6=Tuf0VHp+>sgY?m3JunR>nWqIaaPpTB*UHFm+H&-W-eIVh;Y9qhWWr[?;Lk'_GπU"Qu<eGIf7a36BA)Q/NKedI4HGiUs#6X<O0EmR]LMjkH:QIMORh</uYPtG&ZRZNG*πU"r=Pj%r?X6JNY+jj6FP,+q*#L*Y^];:n5%:HUUQxfw(5$FIk#8;$S6JbaQc5pQY,πU"riNs=H/[X_uM/_UbVgT#&.[zC.ZAk[23jOXQk;hC\tc./m'lQE<C%+\C/O8JI?bπU"*c_t]tt*HpB_S#mh06=%/EF#dH_z=/^%[/8k-5=Ff)gW+Ppc\2#;53+JaFh;jGtπU">F(S<X,^)#_99R%-Qc0>V\a*7W.1r1)L=kjq[0Cre]XgQ_?G1DJ#/:lksa;lVe6πU"bb2DKbSIn1:n]E$uJ^\+^>>nF#(Z+&t2k*q1WUl03;QT<jU\OZCI1Tg.W3<n#^MπU"d1GC/r#W(Hms+)f1Qm.HkF<?j78sXQ=1DH,W6tM;tJm)$(5,O08Lj(D)JVhP+-2πU"O\il&v3fo**(TG]WGK0QZ?VXHrZRn[SCrRsi]%&M,ARN2U*+LNg;Ikd]/.QF[UiπU"3iB7ce-:V07#;IlSF1<Z1SW&Vjg.k(K>/:xE'ZK&%E,7p]2]Gf.Bxa0Rr6SIq^BπU"(VUVgG,-)V$.lBe\DE9hbL#K7-PGn$]]VBO6paXRe\K9\0=%CmC7VfwK074f5/dπU"N5/p&$U#$VnE0qxDBB8_6'Az3qs4?Y0GJ;+il.<BK&\6s:lL/98f8/IJ(k[$ZbKπU"l6d60[r>.JabU2ob7Cnf6t4PJx:u*^HZo?F0D[5.'RB%.JMJg-;6_-SY=31U?$WπU"qQ\_5CBc+2IYWW=CUv^SZ'cb)F;$.88Ytiu&cFd3OgClns$wCk+a:sjC0e)]pQGπU"0LY_:k7UgZofidfI/SGe'>4^x'C6PB-h<Ki2U?pxm]Zv0mk[P0[)_WG7#Kpc2DSπU"Uur>h5<nDU3FQ>(MoP.gkO;#V8T#7SUR=CeXnl0g\^s]^uKrerU(X0\rwt]7]_^πU"i)-V0)WVFDhjNKDPf(uDj#je5*<ikUAU^R2Cp5F-BLt-H3<K.5CjElvbX8*+t9[πU"b&-Y+I1EYiN'WVOEHYB1mQ'-3$<]FLEv(0[k;.g<0F2xOl[_G&=<GhZSa^0>;oUπU">+E>l'4.xX%iQCa>knn$<*cSWWY(<.?+BTA)V(WIf4#>5:[)W8/w1ZWXk<$6'/3πU";U&qK/B4/H%tVNkJd1IgYpJVbXgWs_)jC5B=-pWViTLHwbr4<u8*w/Q?i6uPh^*πU"K:gLrz&zGbrKgdKeR5P/c>ObS\rYp8MLvlG180:p>39dm=bQ5*&LkE[3Xn40)WGπU"mlwT;9tHiz>q+*1.bzZOZ9HEZ#8?q(Zf'b;tjGHFo$2$g-QRC$#dDd>?MBlXi4LπU"tk;*\0bo5$'x8MuT[s40q#ZHF<n0rDD8Bud[#$;f%5-Dp*D\'V?=&Ypt&CXucrpπU"6ZqET<E4^RbarNL'gg=C*SSn9j1G77i+97KIsdE/hO^wI#q0t_imwW#e:pDJxy<πU"aI?7/y5s'n5ikt-R6dg7aX=7>\0%ys-I,l\Abk2zhejl\CWZ0^zH(Ad7UeiHmDlπU"cFC'oyOR'7]f7Cfi'$gfq1CK6?O1f)LHJKMp/f]i?H/1PKZB053VX+[p'[CHpf(πU"]M4WQe*tAJUot;ffj)eJ6Y,68e+kte)-1<8iS\mg:8V50i;*cPgYD?A+Rx=XnnrπU"ZK*HZK),CPE>_r8iP/bUK,q*?[AX$+]/$aI21_3_&6quO9n+;MX11=8F3)VRplBπU"WdT'H]g*m1g6Gi5UgT$=)r6[H7%$dWOC3X%Mu];6lJupMVCRxmf/fDOw:NjDv\+πU"H*,tng._e>AFWS%,J=[E70PKg6[27oS1c\whoSRkeW-#s3hfMcv7>Xx^/xb8aE&πU"bTmdabKouebL+3g,PX.f-SZ)/QuFeLO'4=j3FD93GjkD;HwM_S-qatJcr9VWYZoπU"d+GS7+]Uix$?JiZLKg$MO=:k%4QkuyoL2=Psx9P_4XK)lkO(v?c.4?52#V1?p?2πU"FjRON?mgGA);6.3LL%lr'w%BsTdEj>i:31rU]F3Kf=IayZ0H3#LIN3(Y*/8Cb6kπU"*DFrEZ)X/XFNw/8+J.D%n=&^/y(2<RwX4*%lQ;w5F5hS=.Fl&4Ab]amdh'.pZ.XπU"1f<vFI7<',GkCsD^X7^sG$FKD10[Y[G\PYg=_V8q<L:wS3W[VLF-*.,\+Yku1^&πU"#plW>O''e[/19B$d6iS;YjaeWk*[3,/$Q%BFm#r5iE/*5r\Je#7pK##jAQ7<(JhπU"%NUs)1:/s$g(tIgE*71r8jw7F]UvWp3gG&VCE0c9'/]>WqMJ^g6FAJ^oxH:o>\RπU"qV=DIp;uD=X;6o)(1F'*u=9FH:Pt1Lb%>--CM5MQI/AI-Q['(,[qaoR).r[zdl[πU"CU$BoOQB([_'V:KNx?y.wL$TGMSugRj:/=^BQc]2PMm'q'H*HFMIr_+cqgB:wDXπU"xiX\qDJGvz2Rt]29pPiJ2VM;&q+*[t5Z7#*/NgU1U7\4Og:LmhJ0Tyc*1_=wd4YπU"ROAFqv*jOiMji+#d9GYJ^m.ULF]O<u%tZjo^dCSg4_V%03fFR0/>KCBbMK?#Af7πU"dilE$ZFQM*0jFRU76X8ZR*Ra+jWgv(aTgA1>kFL$Zl>^%hXEBhjsSAIuslL?'\pπU"nNG75)Y+,piT]PuO0mfghqMs([KP.UKTblkgZ(:ovG<AH.z[*JTU=QqX<7z($)mπU"Czpj+A<:m?u,EKiWP0DtLNcRP3]c%[Oeeig:xlgOx._hIJ#qW9u8))n+ZUms.\xπU"je$G_w7(WXI09dc:9=ff?7)#7goTAmHe?Gt.V*j-s\CPt/)c37H;d%T%3O]?S4*πU"c*cm:N,Yg&<da;AvV?n)v=/#o\g+V(<>t[)qS)73G6-e2(f.06,0:]+5Jfd-Vi(πU"PLD.QhD319\X[&R[)XcM?^a)X1=P_KMOHo'hQ#P8m0HRAHYDt][srZ8.XG.A:.cπU"6^3$O/WtKS.lar[5cEL'MY7'qCIgBslh'Eh/nGJID\+&r7IDpwW(+-jk=TCw,v,πU"2K(lfJa/3Pa]T$?0i9[OUe+sM?STZbShvTpZH0/Sq/drLEpQ(UVpO$q?=I18<_;πU"YHS'8>bi2s)a.B7j(+Jl1ON(;;2WSQg0CFHPFc2>(*J/p;nM]ZiC:+yT;HZ.t2vπU"1dPN5yUE%qHcY7AEadnK/S9DgS.Vl=_B7=C9Z-?E6C)+/Tfrkz^YHjGSy4/XlaGπU"[cq'fK19<wgCNVu\ZuWj&;#ICF#AU9YHAo_$hJ.aHk*L<O1;ypIyx1i'f[]1I:WπU"ImAsPo:g#-?FKTZg]k\f$OS;yH8?)QI*sXsdl4gOa#N9oOQ)WQA&dk5<YZV[.4SπU"s?)*HV&OWr&c&[$f97sAuE5bS.BkjChM<5*+N^)cPx%'UIgvk^VtclWnbB5pcVDπU"h=*h=xmd1Xj$rIx2RZ>93qnkixX&sajk0fyDmd1BpH]Q?u7DKEF-Di;126]5_d6πU"Hcx*hJPt.Q;h-9WxQ'*:D1y(DpAF9Jmeo&m,r=/(i[KocM<9:E.LJb\a9WWr0)?πU"AsBuk7lo9)C.W*PTV''pYhQ+=&H&]g9mf$i2-cEtfhQ(0U#w_A:4Sn>C-=fNloLπU"Us%V^j(FvEDWNX**)40=M]VQxW<8zm>uVC_=j7u59;b/+t>HBgA\7L[(hq:%=I/πU",'boG_8yBRX%G]('ZA(Eguj_T:Qf>jpo3x>=XS:?]OC3FD\&yMzlVOqj9p8\q60πU"qhS1?$IEL,<lu=*tV/S?j\XkC5p;9x>:rZQan[qjUU9k:yjz+QSJeA_ukTZO#A:πU";&LKmfV'.uDU(r[d*W7V(0Z<(Td,KmN1ZA\tHR2K7ikFrJy<Fu*YWu+KV:u*rriπU"b_5IFdTue2pH6]=;=-4$:]xPslgc5lfLL4FVj\XmE]oD6R13HM+LO4[>IS-#ov?πU"R&B=at^i77Kj*eBAcQ[<*ik8&Nw4AqmI30v9#7xi&_-]gY:P&ZD%FF&O;.cby?:πU"K5W2'E+M;0rQ0[JPntYuJTw1in<P]:LwL+M_$Q_5p]>U%,J#T:&R)a/KaEcQSroπU"B28YK]9/lJvgYe<Y=wJ&(%gsU(G>9_1.x[2e(5r2WkF1AOOR=xomq:Jb:$e=3a>πU"EBKijSbELFfhJ<KiFacuDE2&jn'9nbd.iZ6<[86]&0^E7_j6Duo6tMF')F^)$O<πU"k%WPwO5GNW>NSid\:gJ?O,W[PVlgQ^>MHUNBBnMhW,*+5rL\hjKBIm/g.A?BDN]πU"-8AV&eXbAl]r6>++F>8KkU\xs\Yfw2TH$b8zk-dbK'EP;ivpq7MaJ*7e>kZdrkMπU"V%nWhq*)k8B.$\'rv\2[(3<VGK1RUO9Gv/e*_)J&1H)R5?TQ.5*iw.615j2Kd5SπU"g1Th;7.OGte5xF$OeA-a%e-\Om4')bMR&J0VDnm\j68iN?D\UR9Eq[/NEP5R,_rπU"w.,FN1cf?Z&kn6;1n3XAkb:OFLKI5=C/1B%KV)T(L;D)X-S>/d%#+.mDUQ6WqXeπU"sjcXK8<qOY\]r(g8SsX>2J3z1jB)1\6>PE8/p$Hfp7T,FIyMa/c8?n;^]#'71,<πU"BYObZY'7.1&sC[m4jJ(Zor/S$05'b%K\DL(mJpUyNFs$Rfl3HsD3\^.pAg93EYPπU"8YkR,\Z%)7dv\91>N_t;JXQci9i'[Jp[cpaJX8,SbYDZPF1J%]TDyXU?\9VI:LGπU"H?.tL;%.**qcB?9^X[Z(a:SJRx70Z;/A4i,w?2;wp=0V'0:3gu(;/Af3V6EkZ\4πU"Sfj-t'oG([6653PhYBCmDH'+:gh-(\'+Tqs?dr$BPBD8ooTy#>ot.W3*K#fIgh;πU"jgeg*s^Vq)P4wUdMgoShUVgNerW1r5WR7i5P[Fm^<4fg5]P1T7)Q6[x]N,'dNrYπU"S:F;JI[\_?*W.t#un/x-G5%a<S:9WILy4/\VP^>]G%9e2.xCcjLS^oAJ_jK[1%qπU"B\9-)xjBzG<&jSf0=mGd=Z%I'-v'Q'W5#kIGaTKisjd*k?T*7DXTj&G=5rB?4l-πU",sOE><m[#O9VXH<?(/I0.iF>(,Fv3lG/qg<.m1bxAhm([/e04%01Nlph8mBRObjπU"SDa;ml,YR/-i:([dFj)Oc>xKksaNCP4#*Lw_*<bg'%'8#T%F.+&'[1(3tmDoQU0πU";(&h--5cC?(z/+PB=R]2q8XNjp>?R\YS&\,%Ii+g+'j]_Tva4l^X>8<*45H8C*wπU"ikAx<rL\%8Rln5pBPb5YmmMsA&KDC*ZTjTf08bK9ub&4tNuc4N,\AyGYiNkRu+JπU"wq:Rs#?+Bp#ccLnw)f]C6Q)ZSTAXL:.Z*YB40]',Nd-#g5I0JF>nK[_53Eb[xo+πU"BW^o\O3$,W2/KVUy7H*by<^vLNA*LYz)4%s&m1^/e(uKan_mT]:;fzAH&m=Q<a9πU"f]og;P_jCY&Pa1'S#z>k-Rn^DUkX6(tR\hLAMvrCW\eU+3CqO)EP:KCFq6.&1XYπU"%+9<MDR*[,5Uh'qFKW'd/lHLJ+2*YNW2g;d\s+gQ-)sHX_+pb1i59\4Q$V-F-u/πU"e>Lg[%eP%wv0#Ub^9:CgwpD_DBWEToeBVP1=uCNm+S'VJQe%m'0uR_;'tBpA?S-πU"fI:((M/xqijI2SN:P=8c0N>2%xkKg#SU?do8C3&iGtJMF>-VM+JkK#UJc]R=sr9πU"^s9x8b%-6p[mvEr.WbAMv:3/<raSE'VD=7<cR3O>X1q.kF_.[r?FE\7KF5[FmCMπU"kf^2\](RSQ&agnTE]RR.wshm93be(bS0QYg[$o+iAfq14teVG&mBb*WD:0d#V0PπU"+<CQw,M)Lr,qi;+iCJ^Vl4$8gL&wxRtONGXlW-I93w]_\P_OWCWt2pd[$Yi)iE^πU"#mG8#(a0*nwvTtBVpdM'ZJ/Gp'Eh=CW*7Y5<+(q[76<<OsnmZBNo_RtmMP_:9YpπU"NptX[puO1_t$9FCbPg5CAZexXie+fn'ELTMDs;v79usBD-l9U(1U:g:,C]8%]^_πU";^<;??Joj0G<Ir\+JG?SDH1IOYh6JZ*L8w%w*a=Z).cYw%mW:H9;M<-)dpS.uFFπU"giqFGP:6>N]o$TV0q:Ltap=0HBastFa/#BV#nU*osiDdLE+>dp*J[LRsN.%7p3BπU"2S1[7Mn=q'=ifF-ArnQ3o'b:h*9r=k\37Vs8=s\)^Ny-x/Z\Z*)Z4mW9IxZfpL^πU"UZA?UIr;#zvZ+>mB.R0lpc1COuOUnL:lpFTJTt4aDbC0mKud%3f2+DW/ufYjlH(πU"B[x,3lh>,H/:yq.r5bR&S[0<2U_R74/E0016oJ:kgfcb>7<#B?pus:1^Rz&WT<%πU"p+'0fcs>U1<>ZWY2pVmn(jTV00XRSjvBV0Go/XxMIgtZ+3VfRZ*Znici1a<kaovπU"A9m4k'Kal1;JLig^J$=h0nZL>++3r9+p4\2w:/r'zld\y*u9jx1QYsS4X2q3C^3πU"UBGM#7T_$b9K_us_qa]-?Mm:#?UVVfnRyWBl=u1q[Pi:Le/PoqTeblP3;Qd3)\<πU"lWN.9[_J=62=Q<a,9\dw-Tlf0JPUBX:^']Lwj1D6zdRc_h%djh/0l5Jmq:)y8eRπU"i9Y%;*1mEeB4<>/peZrCUCTt/I2=9UT'AH/J&ICAR>k_4l;S)V[R>#s_O\jHiSJπU"6-])Nd5.-IH8G%kHK7yZ#Q82=\Wn<5]\T;XS?'?TZRha\NQX-U,C1baRJceG1q_πU"8=8T#oQ:EtoPX$#^$W9;p]8d'4^ro<0BHGCD8bX7anaW#f&>>^gi,4gJO:pJ)sOπU"\875^LYlUjRE6ZR%%,Qz_?Lej;Q7oeMA%4=-fGr/DVH43WaE3fW]9a]QUZ\zEBXπU"7nJ819WriR<_b:h]GtAmok,KI#.BSMrJiS67J18C*.[#Go/WKP8WWqc:[N1[OA.πU"pXX5T&Fi0KB9gShx/)76kl?g<7rAbe-QGH)fG9UhrmJ\fokAP_j\+xT6ls89k.[πU"d9w:)=VbQI,[,;,eKXC+-Q/sl$fet[w]I.G3e7UZ:Mra=b<eJN?o/SL*$,L2tqXπU"W5P.+G:+n>+<G*Y9y&75:,dK5EVVsTBYCXB/?RLF/VYMm_l>/)hd%O.v^no99?aπU"%G4YEK<?=\a11b3u(l%93s7RvgmP/KA(B52e_a+bIds0#q7&<:iQ<^V)]i9^mcbπU"^H?(tO#cw5F'Aa#j0CI3^L\B57KTxH^.j]XM#8qUVLHVY/Q'qFSguVNmon5?aqdπU"bG>+S;U;4q/?V>??pN5^tC(NNJ9Q=+IRe2ql8i2q=?b>CPiqfV;uvZ_-Kk79I2'πU"(4>a;tNk8=W/]U7EHj\2m0b+L+9B-\U9eU/K7+gb;b<mgVF.eA<bHl:/sMQD(HRπU"o[[n5:9a&CL,w^wwyi5T2R%#1t7.gbJuBH]TPWV?>p)7hqn60=#n?9TSa\U?&/zπU"NWJnOWqLwEgQbNpIm4(o)?#.dK+wHCg\O$f<o5BUF/<pSmDs4X0;m.*^&Ot\1OXπU"WFBoH%G(+iQrhwoPjHXx+Q%aQeRKjz>?cWc6FDF_XFcL>'&u?&:MdtA1m03ZC$TπU"Om&OaU5.;LseS:)c[<V]Iy&]^2\'w4):c%4F0q2e.S_op^n0(\SU%JPlZMbqiHdπU"d$_kk\>00xoN-U,TK_$)6oH53V?IAa+hSs]$;$Ed1]'jwqRC6l(>UwE-<8Ov;H)πU"'Q':mWc[7QVZAIQrx$bS#'Ssjq*IhCiYW(>TS*E#?:IHK[0Ip%WjC%:<-Q?Kt]&πU"_cV'JiT2R2'Q)DYd<Hr#I)(5xT:_GR'*=?uPTM)to/hm&gZnjU3)-Qz0fJ\C3M'πU"1%Fi:pAqe<\upE=h^qD>UblWe;L$cCkPu$4Zms+(3fM%>6jidM:qWomr7;=.IkVπU"$\D%o04?:*dmpu7'Gff?#Fc]DaY'<n^igq\SRai6h*Wn[HoGW.?^bkJs%uX5P/IπU"#L0'_Zhsa9e&/c6hbt5fi^)kx*2A(/4WLu1VQ?E?l,;BQ1gZ\PB,EQ?aE=(yQ=KπU"fW-<3E:EUqLh6eu.:)cjB>BU)KPy:zVm\uw\3QU1*g-kT,\HMsUsaZJJT\H:Bo+πU"f]ph*<B5*uNrvlPjItI'A6gC$<qSG5?jpN5lm%yi^%bhw<laHM[$p%m7msmpRwJπU"rnSyg*E5:ey-.=.K1;U\<h+&up^\K&=wb=U_(Sl[c.Ew/?huqeII#5+)&KlA*y*πU".((\3&PJYms)X:[z>Fi*>Zml^Ih>eq9z/n>ud7F>2pTVJxZlvun<SL;UBui-SPSπU"++h[b+2HS[,ba9?G8n0KCp2J[C=e]J>A8ec,uX/.R,ZMC#7[*9wAfY2A(gb\+N:πU"ut?XBk=W+oC(=92b0b^K<m,ZLELJ8+dK_Ay.9jehO:We=M^b%+4yWA>%-vbR1wOπU"$^QJLK^2\9%kL#VVz(<wJms9tpQhGx(Nis.b3QI*4Rc8DO59J;h0tro^z[U3>9.πU"VlK.L\I+&[YX)Wrs<0F+95O.pXT9f<KTGVP11+q>Uta#nTf/-38o_&+4kXP4vzTπU"dVWvjl[8ppgK[<V%NSGFnNehPYt<F.q9Pv^]1ex=A_Q#O1'_oMhslP2eYSbq>deπU"-B?RUhn\TVwJ'-e&L6b3(#P,YpWHZasPpp0+LEltd%7Q:D0F]-9[L%hQn*r,7MEπU"\rx4wqn7rZOK/&%u1Fr?KBu(ZA.P1;/ZXXmN=QnwY^H_aMU6^oOJ5WO7XE.yUT3πU"o&Zu$<Q(n9JPPVEHYCCC:lzC6hutP6#r,12%y+ama\G-**NPS%=j=3ECxPHy&iVπU"FzqvIkDn,z6+#(NU]F'/]Q/E_[gZ0Gs,tpN(tuJh3:XbrIy;,t3XL2)RjnGf1kVπU"w.4BC'62r*NQtckzVL+\.03hrcnMdut.nptFt._?Z3wbLcz&Z*F0yiC[0IP,Rn+πU"3\P^#[\R7]kI[h_ee()(]j=Te)6NSVi^s(^?hZsbFA$.-yFV:qS6M)U>%./h1m9πU"\VDU7,9-+3cw7;<TX7\$+x]d%73NDWwNkSS/?R-Q)V)(/vf8'oZX(H[cNQ]In1jπU"4qnyh;yIl^YWu<HUivrvQL)oNTe*rVVKirVdYNGaeV0GaseiSlS5+mq8ohuxqcNπU"1h9o$tzRGC^X75+..*,R;aJT-*G<VlM1hXU?b$vc55(%CWOgBe>90\,5yeWzrR=πU"vM.+1MO/Wn?(\1H:t3l,S$?u<;3[\[Y'\imHm(Q7qVD0T+fo;lH(1/nKG(fBYv3πU"A*:S(,6,RsdFwQpcAxlx<)H9e7rK\?uKID%;D4o*2oO(m\&syKmt8AS,V=wW_DyπU"&:4tjioE6Ku*et?wx&%M6Ga8MG&6:7]i[ZE,r=m_%FJ<nHOc2UF/)1bi*jT3RSnπU"#)=z+4-c+I:#$,N](gZV^0Pvi2(wgg6hE;=MYSOWt^n3*\1'asb^m61F8Y68WugπU":'>\)u8KwcRn:q)c-OD;:LBg>JOrMMqtTXO;$oU2?e1SxO+M38U=GsEe)JRy=5/πU"h,zIX=YnKBqytipb%(34<O2R$u3)P8p0^D&+wQLJggiak%Km&d3v\j7']=URec+πU"*Qlb'<IfOas[ETnT3[$e7W.bGe^mJbK%ghDD5o/2gA]Fv36unu)(KsUF2H4FNnNπU"LhRFDWf$5VUM=lhwYV=%:W=B;F2V4YxSbrA-+ksBaoT(h4WO0Q#85Sa2c]4Wsw,πU"T22DC*qgrPh+rm8G:G\L$7vH8KA9KK#Q[e-s2V/T)PQ?kbV<4r+ntNXp;.Qpt.fπU"h8tKr[>sL8uw\*zq[&q$A>1:/cbp0EZ,rxKu(TxVMzdbWAT#(Eyi8UmD;M>L?gsπU"v=pANqDF7(Y%KScWqdwZde8.Pk6GH>EoklpZ^:nG?u_<i&[,50nL(:nNt7.E%P_πU"apw(9GcMm3mSy3]5pAwBQCN7[0LpDE*'V+pxch6Tf2vULnLw(<=al<3?TV>_BKvπU"uQ_3GaUnk0trj-)O#4N4f^9'PE2aJy.y-qV?rw3TC\,7iwpor.DWgT1<(-YFxjDπU"ch+d1*s5]?t.X5rlofF.GI.S$*R+R%().\-(XMpIM9x#[ZQ>MT+2>0[UY0+$LHfπU"or*a+h0j;#s;YDe1*(Or_idC(un;058Q)K7(m2RYbJ?L*2*3,RqvbIoj$Su=Yh\πU"DC,bS$f<;]%y?%/d?wmCr#qqH2%?3^tS\b9>/JVFKEhF#5)krAb*p>MWKK0F*<1πU"A;yOEy))as:(EzU+E6A/#O#;.R\yi-^D53ZOJD91s(BwY'm3rVG#l7^2ka)7^[*πU"Y6$#G$nl7+*V+c]OUAM;%?seBlcwElQrI>kCCN]4w>_Xa:3Wtj.A7<)2Gr7V\6TπU"=,_*=8(aIOMb_6kbINWr#-hw$Ht/AO\9,/w6H54N$9k\0(A5P&T^6^I)W#7jj^OπU"y8:;UhD6c;A:0WXc[C_sHx4x3NIrbFvQkPWXg5t\3aZV^<[UqjIk#\R*h3l\f(?πU"N'f,kOFHMlD:989x(9;?sZDfYvF:\,wS8;A/54c'xMBN-$ITD[j\rndXH2aKiu3πU"df9:>UE4.kG09(EQ7rh;7g'_6fAXFz=/_m7N).5fqsfr1+u*OvMDo'Mr\C-P)o:πU"-&0E0?'TZ/qU4\WuN-2P]EQg)s-$Qt$TA-,XP;D/dphU\Q%pq9A9ML+m4=FwTAEπU",>9_agA+^48L\N[gfEQuA';I&I=?W)c_N7KO1l)s*oEk0Hn$]KT#',xN&$Q.LG<πU"aV>3a0j-VV$RUd4N(**q1t*oSd68e(tZ>T,8x1JUtdohmnaPY9LAodrX*Jh/vTrπU"]1Ee$8t6t9=m0;:Z(;rd'y$x(>V/ug?WZenI8q9);4yGmJPsHsU[x?iZCxeChJXπU"(o\l:I'Rl=?RPH.x#D+q&GIFkv\9rN\\Zprte(s[$Yi:5[L\:^[R=+tuo^b*C=<πU"spHCXd$\+v?)El-d6CExpw8qq&fQFf]67r\saZU=gYWP20aOjuc.,d-9-e__LNEπU"&P5N;CLEqz8kS=rWL/_z9]Yw>3\MAFEul&HKl?qDT4fHZ)biyH.AVMfo5c'k#:pπU")moPC/-mgER&?SW0v?4:.ErFM)'uZ=^?A>0?64[OErHS3aq?Ej8:A4sCS^WT$*pπU"82+$RQYBNftVnuVNJEhd_?NjmVdr),2w(,#RR*NfKnN9mvdrxiownuq*^s-<]wBπU"Df_'74'?hkH8__['OXX.H*Gv4]f$dKE-rq5a9BqFy<.*/3$&q1m3?n$q0S'G]S9πU">;WOrd4jo2(^w>k6GT<1Gpd0xHSi*C$gw)OyH02Y4?y^R^qae^F*ZrsZOFBXz4\πU"J3_z/k<-OUa9wP88%$'jQ<C3#BD.0XIlrJl)ehO_qEH]Nkii3fgeR^57\DB/)jNπU"e]u-Oo[UJxOZP[tINo.nceU(cpAaQux]VR1#[DX2?'3jySK)iu?:90oj3<Ex[wYπU"f0uwOzfimkdmCX+1J,OL(z9Ii91KK+N(K_^d3XwJsJiFQ/EDccPNlP$$e2SOWNbπU"icbhrNt2&wS6?bY[-qTC*8A%Pfh9i'YbFch;^aa.k\]V-E.;Z-E]&;Wj,$^,kelπU"wr9$w-jPOj$/o;t07o.PA/93#byb+VbI#5V;4<t6Fr3)0de1?VI6A6UaT-o#mtnπU"TivfhGRNki%L3^^AEE0w/-t<&*RWF694#=Qo[0RXnZfp7bTcjcfdhcFgm&#X*<1πU"COeM^[9I4:gCOZ&,XQFL-qeoBnt]*O7p\aeF:GR\qjcSBf,>=.:LMEz)b(dyBD4πU"AP4P5K)^tnAhD%5:Ac*dP-b^/zjuX&egwJ=*f':2hm8bg#ZC;.z-.c/4<K;Gj^mπU">/\vBSO2-(w3+uJ:=vGDF0$38$,s\5<BvE<_C^Q>W<+e*H#/Le\a\wiM)+%UyrbπU"3&%;R(aqbIJq]\w;_#>Mv&O8Fpd'>%u(nS2T4lO9X/g1h?M\[X)l)Bnk:q;XzHEπU"K?(RdnMRYlg?tJg'>],?aT$cYMIE/Z'A90)o_S9X#,Uz:1$EG1'LrVzhQpJNt:.πU"rS5M(a\6Vj:wuvw1C2V_/XD\Mx\D]NN>Nmz9C-N.?Nr=DhOWY,S/5x/GXm<jL9JπU"#+DF4fXov?ci+Hi2J=8hU]1\kK?;.%+n9\^9._5hVLUS1*zE0m$:B/TigeB0?weπU"2%6EGJF$Khj/o^SaF7R?Z/kNQMj8+FY\bA*j;x$>L^PictLZN9T^,T8E.kc3Qb^πU"QZ(q0adwZ1TLo;.mZn9^aHK8?B2RTH^.Nmp\2:dOo,1Y(wkP4A-O*pN;&Q2WvrbπEND SUBπSUB V2πU"3Yz>),qDM8ih#,YE4[oP3HhzvZ7Mm=\cSv2NaTx-ZG/9EE'R4E>gF4<GyR01n5pπU"TQ\VlRSbhM,LT&isBO07/qb5^pP]l$P'>JE9V/cUrkW:3Dnl'58a8*zxuRUhNo.πU"#Ip=T<?)mXw4cf#zuAao#;R-fH1-TMwiXKN)pJ^9dkuh6_Ku?+ijrZdE<K0+2?=πU":e6g3hJ*+&C91vwaHkshPVibjF'vb8io*8dwU1[<KZNMbbMR$ILd/'>K,M_rn-4πU"A71/wd/MC#/<N3j'Bn:xc(c%dxA5Xz7kUQ.-u.BpG4)0]/$b46kQj<S310^8F:6πU"ot>5G.MA^1>\\jb$O_gForscFmD'A%^S4kq5_[nbJh<,acdunwED;y[;qsYh'jpπU"US_25Je,xYAfM1y*&WUcV99b^7IY\3)1PtH-3So:BCU*fnU's#jEM_xiJ;ihX&XπU"^'X6HULfe'OS^]\]G]^4UE?M0WF>4FPmK2(tpl#l$j_N*e-+iNG5epMU#W(GeZCπU"8'o&9mQ>:bi\[qRY$_u/QHF$rs>4j)OMjd^Rs&tcd.hUdZG<<iQ>cAT6exBw[OmπU"<G1MKx70g)ck)DHRfLT9iE[$?/A(mq8Fom7pwZcK6QhJIVC:NNe,XXym_>?UttCπU"oS:\Nu9&oP-pm$NTa\eF*CJ2jsu5V\qy*WZW]wrstHseqkBtJXsi#oNZ.JL[$6'πU"tWZ0PO<76b+H&0g>Jf$Q/H:X>+2CX(4m5dlo/Lq1ej%O:Mw4<k?iAleHZ(fdffJπU"RS%+4-+H6I*u3qOiGr,%E+9kHOUDbGq=N()p/aE[rW?4M&'-XK]zjqIYzgSJ(n8πU"VMuB0u8PG:8=<85pS]gCa+1Oii(^]BKo=B[R_L9vJ&BPLz=<c-'tUD\3RC7]r&&πU"Qyn^Fv2ODy7nu>K9S3HN*ypb[=*s>PT(23O(Ty6dH19Y?-NPB$;A\&#AJ^0K43%πU"JuV'ZnqG/a8rjJP/Wvz>$>i1.B>9p3r]jNK>KHZ%C\5H[*sL%eQN:9y*&*YgowPπU"[?E.pg'DrTYY.$0[r)W'JW5egsEFOrn]'kmrLpZ(Qf*JqIzGFm9?[-KQ&Q;Wf.$πU"8R7a7(;1x/xyA<NX'8X<3dC[o31D<0ga/%>C4sUIwvsj%GWb'0&9P_5scsoV8=?πU"R(Fp$y-L%Zp^'vj)e;$d9+<e,oOs.sR$^'O+'\ai[*/HuLVSwDtl/NdvbwTij/?πU"#43qrJ]RfeNYV$JUV21&9.3j0&*^6,Kh5\GV))^BIor2PO(R8flju3$$5D'-%b)πU"&j?1XTUc<P>EQQoP_Qs3C'h2+LcM+ABb*/*&fc(pQU^9$22%bhBJkBT>f>og-'2πU"XaC^^$hc*mf$h6*/w?BggC?2S=pEt:<1etZ7RFuMgTcYsU['HEBZ%pB2HMkyffEπU"XubhS;HCc1*JXhTO#%)kU^DeW?7/b_4o/W.MGlX;<xCvOTE1L/i[&9n4;vdnYY^πU"H(odsX;*:KT89&gQUtadziCw0X3;Td2nXzX)&j91/KdM:8=v;'#chGQ-TBnQT^)πU"yegdSm71c$oc=Mw&iH&0lP=6081wrxc4S)H(<5TF*>I1jl%y;JpO*i*:,QR/zdKπU"sy'5jkfsiN,i/FlWc2v#qHFwkbmg<<,%4i(qS&pme=4EE^BYYeogccoZD4lf$pCπU"D0;EC$T,BVP:l2^2,kr25wE_mfJ2R&hfi&O#N-p1u)>Qijb]E(H2>ag2:$i$o$oπU"+P51s=Mj<A/Zp3d;#',T*8S]t7%caHN'XNYDXo^67R0%K[TFFEXhZqNr)9_fDKBπU"_3OTm*jnvS]^O7fTA6YO188u0f\F9)P7Fk#YSU'du/Hk%ub$',b+M/aGR9bP6=PπU"bkNoGX*5&Kj2_lEp%?ak^?m%\P=JSMe+XTRy4F)?OC0[C0[\<o:qi>>/bSOkwzoπU"F=M_gSP4j#+S+ffFWvty)<-mm%\p2vNHHZDlp5'%3vne8)*F]m2&9Yj&H[z]F0LπU"0iO#)9+s*4-NKYoU<2'-3P&Q/ulc?FOt^,xykIZWI;8m=rp4hqQBQwrm[eq:c2qπU"f(3sNTu1U7QuM/WCf\%k?5/cD>5=^%Fp*f$fpe<:68:u+Dc[I2b<qPm/r<NL)aGπU"p^/\'O-[f99RYu<&cFA?h5u:)z[$;[h/gJKN1nk5#0^73/+2P(H[Js5%:(hD4loπU"CKO5yU+eX\rPPcWZajp$c)[KFIX7.f7;CHUZ3?V'9^.?iHxys^MN?.taWK\q4&5πU"T8(i6DAmXhLkkbg(z&-a.RWP:44rhVB]l.b64Knpl;<zxA(zmhOUqys^dHrxZr8πU"*uE#ArgoX<wR:pQsdfx0ZsIC5HNB8/02GFdU/+fkEq*wM,KQx;P1Zu]j8B,sip+πU"Nq'9\wM,]2oGlKIjM=#;nXa&\Jw'i#j>mBFw_vd(m^4Zq1L1(qs'gUIboI9SVZIπU"X7wSmbSxZB6Syf*3/*Sbc3I9e3H((i5BU46Pr8aP(*]j9:f<:.H_&[d<b%8X9A>πU"$NM/>qgth3.LGZH^>ZjOG4[XJjKj+L[PABnOL*g29qRbp?Man?hv#??7QRrqR#bπU"XrDmMHV6=rVcTFk:9+Rw2o(M*LT.5%jE7-Kk';.4qQ0pNTdd1S%tIgeEWC=H.YxπU"-&g1rn_B\NXP\ljXEmg58p>B7.gDV*_:3e%O$>ASc$0cUZ#c8n.wr2^e7KQfE.&πU"k&VdAJvRS:3P'dY<it(9hB=aTPA_3u_89()w\CYrtf4Y>YR8Yq6>;wn_*5Ur.O,πU",BE/5yVf;DolOkS%Oe#M0cFU0gDRy\JWPuufrQcx++e(CQ_=ET(8E%xy=%xM)m3πU"6ihALM2IUD;pjnjB)xshgj=Up=6gUf[MLI%F[90#s3%G5v6H;GRZ35?xl&upfviπU"c7V.i3#94t7<Kd4%1,pJ7**^#B,Eob8DuNy]ZtgRoMKM5$;xaODT%,(Sj,d.He)πU"]7Ni7+_TRbs0[bdu/i_fK0uL<%Zehc5qBE#L^Ds(([[-khTF<%b#<+V-Fa9-,8KπU"+O:%nx5Md6Lnc]5hpSjm?1K*TAtGLT.WnpQum%di_TW&2NZR_iVu1._q/%iOn5GπU"88czU6WO1tL.A67Oc8-48#fyA>_#6>=n$CE']e'VS(JM6K^;sr=G/[P.6ag$i&6πU"v)*(OzeVbx&zUOmO(eiXjaBa9H]buCVjCi$Szr69qkwbp1ek$8vkP3'#Ek(FWM*πU"OYCeGVD$KKVs&pPcw=,t47J)N]7,Kl+Uhg9$N)rhkpqI(um_]5YVsc35sJJbGV>πU"&)64VNNQ66vf<^:ES]WgujcKm:g.et\;bT6S+bfdfWo8BNE'%-P0TOh6WME+%](πU"&1aS#Ue:iY&A^=&s8H</lz'8dObrC13ew+-Meuc6IUqZXA/Wajv4t+hQ9D]d'WBπU"#'J>c/KK&KE\Ob%$$JF.R1uIDO64aSzk0(1X>3TIxZ;DK7QK8WfhdS,_:^i'U$uπU"fU->agSdeNDRS9F3*cV4Hplgvp1b+\4F9ZLa8Ufp9fq*4NKju,ql1ZA#k$,+Qk^πU"FHRBV_a4Iu$J(cIWw^=onKiuBf#VnVJ#LH;eK5&Q%v_XxsXpH^108-8o)*u,f90πU"6O4*U,:_?6r9FBuf&O^Jd>Z%5Y+7r,#uOY+p$7+8HIqM6<,0G\m4:Z#*/)?9,*/πU"qYRwI9>R,))i/Zl)khBbCgkluq]BbE$.aL\Ey9OGxOQMODe+8\0cT7$X,Tc':J[πU"wECcX>ZuBT%Q&NP^;zYRsk=Vh1WFYWU?KiLdn:Lx9h-5iBUKK6^V98Ze$5pc,rdπU"H<6X3V8F<TW*tM(y.-4YA7HfXd3lSY\Fi)zyezj9k_\_QH?2&v)RT$RZ.>[y#MdπU"tyvir^w1G<TZ(oVJc)>Nj5s+An=u>aD?&:r1Qa5mfNh=p]#-/ra20>C7h<&<'s7πU"otED)y1Z^u:F3Rd*yB;S$1myGp*MyyPS:>)jECG#4PcqIx.Os-%E\q4aF*+bQ;aπU"S,erHirkI/Zk;R174.;UKCVVRm]YVhqJ]Xhe/?CLcYe_)^=;pH2PvzI0Hd5=*1pπU"hTT:6.GG-*:c-8v]OFT<$WYJC9Bf[Od)NF0i^rOhie$OZNo=5w;3[99Shy7bC2&πU"y6js:UKEbqkx*^]mowXrRWRD4$G]hg$+x%Dup&%'9%9%%%%-I%2\*jDATY-vdX%πU"=%[2%%%1%%%%%%%%%&%E%%%%%%%%%f%wifk%VZVS%gfxu%p*+%%%%%&%%&%_%%%πU"%:%Y%%%%%πEND SUBπV2πCLOSE:IF S=226AND B&=Z&THEN?" :) Ok!"ELSE?" :( Bad!πSUB U(A$):FOR A=1TO LEN(A$):C=ASC(MID$(A$,A))-37:IF C<0THEN C=91+C*32πIF K<4THEN K=C+243ELSE?#1,CHR$(C+(K MOD 3)*86);:K=K\3:B&=B&+1πS=(S+C)AND 255:NEXT:LOCATE,1:?STRING$(B&*50\Z&,219);:END SUBπ'>>> Page 1 of ARDAF.ZIP ends here. Last page. TCHK:226πUnknown Author(s)              ANSI VIEWER                    ANSI,VIEWER                    Unknown Date           QB, QBasic, PDS        82   3005     CANSI.BAS   ''''' -=*=--=*=--=*=-  begin CANSI.BAS  -=*=--=*=--=*=-πDECLARE SUB ansi (a$)πON ERROR GOTO botchedπDEF SEG = &HB800: DIM SHARED SCR%(2): SCR%(1) = 80: SCR%(2) = 25πWIDTH 80, 25: F$ = COMMAND$: COLOR 7, 0: CLSπIF F$ = "" THEN INPUT "File to display"; F$πOPEN F$ FOR INPUT AS #1πWHILE NOT EOF(1): ansi (INPUT$(1, #1)): WEND: CLOSE #1πfini: COLOR 2, 0: FOR S% = 5 TO 35: SOUND S% * 200, .1: NEXTπ   R$ = "": WHILE R$ = "": R$ = INKEY$: WEND: ENDπbotched: COLOR 2, 0π   PRINT "file "; CHR$(34); F$; CHR$(34); " not found"π   PRINT "error"; ERR: RESUME finiπ''''' -=*=--=*=--=*=-  end CANSI.BAS  -=*=--=*=--=*=-ππSUB ansi (a$)πDEFINT A-Z: STATIC H, W, R, E, L, C, F, B, O, V, E$πIF W < 40 THEN W = SCR%(1): H = SCR%(2) - 1: R = W - 1: C = 0: F = 7: B = 0πIF E <> 27 THENπ   IF ASC(a$) <> 27 THEN GOSUB CHRout:  ELSE E = 27: E$ = a$π   EXIT SUBπEND IFπIF O <> 27 AND ASC(a$) = 34 THEN O = E: EXIT SUBπIF O = 27 THENπ   IF ASC(a$) = 34 THEN O = 0π   EXIT SUBπEND IF: E$ = E$ + a$πIF LEN(E$) = 2 AND a$ <> "[" THEN E = 0: E$ = "": EXIT SUBπS = INSTR("HfABCDsuJKmhlp", a$)πSELECT CASE Sπ  CASE 0: EXIT SUBπ  CASE 1: GOSUB CursorAπ  CASE 2: GOSUB CursorAπ  CASE 3: L = -1: GOSUB CursorLπ  CASE 4: L = 1: GOSUB CursorLπ  CASE 5: L = 1: GOSUB CursorCπ  CASE 6: L = -1: GOSUB CursorCπ  CASE 7: V = Cπ  CASE 8: C = Vπ  CASE 9: CLS : C = 0π  CASE 10: L = C: WHILE L MOD W <> 0: POKE L * 2, 32: L = L + 1: WENDπ  CASE 11: GOSUB ColorzπEND SELECT: E% = 0: E$ = "": EXIT SUBπCursorA: L = VAL(MID$(E$, INSTR(E$, "[") + 1)) - 1π   C = VAL(MID$(E$, INSTR(E$, ";") + 1)) - 1π   IF C < 0 THEN C = 0:  ELSE IF C > R THEN C = Rπ   IF L < 1 THEN L = 0:  ELSE IF L > H THEN L = Hπ   C = L * W + C: RETURNπCursorL: P = VAL(MID$(E$, INSTR(E$, "[") + 1)): IF P < 1 THEN P = 1π   L = INT(C / W) + P * Lπ   IF L < 0 THEN L = 0:  ELSE IF L > H THEN L = Hπ   C = (C MOD W) + L * W: RETURNπCursorC: P = VAL(MID$(E$, INSTR(E$, "[") + 1)): IF P < 1 THEN P = 1π   L = (C MOD W) + P * L: C = INT(C / W) * Wπ   IF L < 1 THEN L = 0:  ELSE IF L > R THEN L = Rπ   C = C + L: RETURNπColorz: E$ = MID$(E$, INSTR(E$, "[") + 1)π  DO: E = VAL(E$)π  SELECT CASE Eπ     CASE 0: F = 7: B = 0π     CASE 1: F = (F AND 7) OR 8π     CASE 5: B = (B AND 7) OR 8π     CASE 8: F = Bπ     CASE 30 TO 37: P = E - 29: E = ASC(MID$("@DBFAECG", P)) AND 7π                    F = (F AND 248) OR Eπ     CASE 40 TO 47: P = E% - 39: E = ASC(MID$("@DBFAECG", P)) AND 7π                    B = (B AND 248) OR Eπ  END SELECT: P = INSTR(E$, ";"): E$ = MID$(E$, P + 1): LOOP WHILE P > 0πCOLOR F, B: RETURNπCHRout: P = ASC(a$)π   IF P = 7 THEN BEEP: RETURNπ   IF P = 13 THEN C = C - C MOD W: RETURNπ   IF P = 10 THEN C = C + Wπ   IF P <> 10 THEN POKE C * 2, P: POKE C * 2 + 1, F + 16 * B: C = C + 1π   IF C >= W * (H + 1) THENπ      C = C - W: LOCATE H + 1, W: PRINTπ      P = W * 2: L = (H - 1) * Pπ      FOR L = L TO L + P: POKE L, PEEK(L + P): POKE L + P, B: NEXTπ   END IFπ   RETURNπEND SUBππJamshid Khoshrangi             PB ANSI-DRIVER                 [e-mail]             Year of 1993/95        PB                     1165 27347    LANSI_31.BAS$IF 0ππ  LANSI.BAS               The FSA ANSI-Driver             LANSI.BASππ                              Laleh's ANSIππ                              Version  3.1ππ                LANSI.BAS is now PowerBASIC Compatible!ππ        Written by Jamshid Khoshrangi (aka "Quinn Tyler Jackson")ππ   Copyright (C)1993,95 by AhuraMazda(tm) Software.  ALL RIGHTS RESERVED.πππ  USAGE RIGHTS:ππ  Although Jamshid Khoshrangi reserves all rights to LANSI.BAS, he grantsπ  others the right to use it in whole or in part as long as any productπ  that uses it explicitly includes in its documentation or opening screenπ  (this left to the discretion of the individual programmer) the notice:ππ       "ANSI emulation provided by Laleh's ANSI (C)1993,95 by AMS."ππ  DEDICATION:ππ  This driver is dedicated to my wife Laleh, who has tolerated my sittingπ  at a yucky computer terminal for thousands of hours with little or noπ  direct return to her.ππ  UPDATE NOTES:ππ  UPDATE NOTES: (10 SEP 95)ππ  I have upgraded LANSI to version 3.0 from version 2.0, and it isπ  now compatible 100% with PowerBASIC 3.x.  The upgrade consistedπ  mainly of changing a few dozen CONST x statements to %x, and theπ  like, as well as using INCR x and DECR x instead of x = x + 1π  and x = x - 1.  During the upgrade, I discovered a few insidiousπ  glitches in some routines, which I have fixed....ππ  TECHNICAL NOTES: (31 OCT 93)ππ  LANSI.BAS was written as an exercise in my investigation into theπ  the complexities of Finite State Automata (FSA's).  ANSI graphicsπ  are particularly suitable to an FSA model, since they rely on a finiteπ  set of commands and use a type of Reverse Polish Notation (RPN).π  Reverse Polish Notation lends itself amazingly well to efficientπ  implementations of Finite State systems.ππ  This driver includes non-ANSI "ANSI" music support, but this supportπ  can be turned off by setting the global variable GV.Music is set toπ  %FALSE (0).  With this variable set to %FALSE, LANSI treats music stringsπ  in exactly the same manner a typical ANSI.SYS driver would: it printsπ  them to the screen.  This option has been added for ANSI purists.  I haveπ  yet to call a BBS with such music anyway, but hey, why not have it all?ππ  Note that the music supported here can be full background.  A 6.5 minuteπ  song can be downloaded as a series of music sequences in about 5 secondsπ  and then played over then next 6.5 minutes in the background on a typicalπ  2400 baud modem using the system I have implemented here.  This systemπ  buffers up to 200 "lines" of music sequences.  Many terminals don't allowπ  full background music, since they are not written in BASIC and thereforeπ  have to emulate the PLAY metalanguage.  BASIC has direct access toπ  "MB", so this is no problem if double-buffering is used.ππ  Also, LANSI.BAS supports a subset of the ANSI keyboard redefinitionπ  capabilities, unlike many other ANSI emulators that totally ignoreπ  this part of the ANSI standard.  Support for keyboard redefinition canπ  be toggled on and off as well.  The only two formats allowed are:ππ    ESC[{old_ascii_val};"some string"pπ    ESC[{old_ascii_val};{new_ascii_val}pππ  Since keyboard redefinition is limited to the emulator, there isπ  absolutely no chance of so-called ANSI bombs slipping past LANSI andπ  into the DOS prompt.ππ  This code is, for the most part, raw and undocumented.  I've done theπ  hard coding; it's up to you to figure out what I've done.  My beliefπ  is simple in this regard:  if I cannot decipher the code withoutπ  detailed English comments and remarks, then I probably should NOTπ  be changing the code!ππ  If you can understand the raw code, then you might want to go andπ  tweak it.  I've found that I do best to leave code I don't "quite"π  understand well-enough-alone.  Be warned that FSA systems are quick,π  but prone to nastiness when incorrectly tweaked.  That's the natureπ  of the finite state paradigm.ππ  Also, you will notice the term "VisiPlex" from time to time.  Justπ  ignore it.  This will follow much later, and is included inπ  LANSI.BAS just for future compatibility.ππ  I sincerely hope you find LANSI.BAS useful!ππ  Jamshid Khoshrangi (aka "Quinn Tyler Jackson")ππ$ENDIFππ%DEBUG = 0ππ$IF %DEBUGπ    $COMPILE MEMORYπ    $CPU 80386π$ELSEπ    $CODE SEG "AHURAMAZDA"π    $COMPILE UNIT "LANSI.PBU"π    $CPU 8086π$ENDIFππ$OPTIMIZE SPEEDππ%TRUE   = -1π%FALSE  = NOT %TRUEππDEFINT A-ZππTYPE GlobalVarTypeπ    STATE           AS INTEGER      ' What state is the FSA in?ππ    X               AS INTEGER      ' Cursor ROWπ    Y               AS INTEGER      ' Cursor COLUMNπ    OldX            AS INTEGER      ' For saving ROW with $e[sπ    OldY            AS INTEGER      ' For saving COLUMN with $e[sπ    RemoteX         AS INTEGER      ' The remote's ROWπ    RemoteY         AS INTEGER      ' The remote's COLUMNππ    ScreenHeight    AS INTEGER      ' What is the height of our screen?π    ScreenWidth     AS INTEGER      ' What is the width of our screen?ππ    Bold            AS INTEGER      ' Bold attributeπ    Blink           AS INTEGER      ' Blink attributeπ    Reversed        AS INTEGER      ' Reversed attributeπ    Concealed       AS INTEGER      ' Concealed attributeππ    DesBackspace    AS INTEGER      ' Set to %TRUE if <BACKSPACE>π                                    '     is destructiveππ    ExpandTab       AS INTEGER      ' Set to %TRUE if <TAB> is expandedπ    TabStep         AS INTEGER      ' Number of spaces to expand 1 tabπ    LineWrap        AS INTEGER      ' Set to %TRUE if in linewrap modeπ    CursorVis       AS INTEGER      ' Set to 1 if cursor is visibleπ    Music           AS INTEGER      ' Set to %FALSE if in ANSI only modeπ    Speaker         AS INTEGER      ' Set to %FALSE if sound turned offπ    BeepHz          AS INTEGER      ' Beep tone in Hertzπ    BeepDur         AS INTEGER      ' Duration of Beep in ticksππ    MapActive       AS INTEGERππ    ForeColor       AS INTEGERπ    BackColor       AS INTEGERπ    ColorAttr       AS INTEGERππ    ScreenSeg       AS INTEGER      ' For direct screen writesππ    SavedFlag       AS INTEGER      ' Has a $e[s been previously executed?ππ    VisiPlex        AS INTEGER      ' Are we in VisiPlex modeπ    VisiVersion     AS INTEGER      ' If so, what is version of other?πEND TYPEππ%LOW.LEVEL  = %FALSEπ%HIGH.LEVEL = %TRUEππ%ANSI.F.BLACK       = 30π%ANSI.F.RED         = 31π%ANSI.F.GREEN       = 32π%ANSI.F.YELLOW      = 33π%ANSI.F.BLUE        = 34π%ANSI.F.MAGENTA     = 35π%ANSI.F.CYAN        = 36π%ANSI.F.WHITE       = 37π%ANSI.B.BLACK       = 40π%ANSI.B.RED         = 41π%ANSI.B.GREEN       = 42π%ANSI.B.YELLOW      = 43π%ANSI.B.BLUE        = 44π%ANSI.B.MAGENTA     = 45π%ANSI.B.CYAN        = 46π%ANSI.B.WHITE       = 47ππ%STATE.NORMAL           = 0π%STATE.READ.ESC         = 1π%STATE.IN.ANSI          = 2π%STATE.IN.INT.PARAM     = 3π%STATE.READ.SEMICOLON   = 4π%STATE.READ.ANSI.COMMAND= 5ππ%STATE.READ.OPEN.QUOTE  = 6π%STATE.IN.STRING.LITERAL= 7π%STATE.READ.CLOSE.QUOTE = 8π%STATE.READ.CONTROL.CODE= 9π%STATE.ERROR.RESET.ANSI = 10ππ%STATE.IN.MUSIC         = 11ππ%STATE.INTEGER.PUSH     = 12   ' push integer to integer stackπ%STATE.STRING.PUSH      = 13   ' push string to string stackππ'   TOKEN TYPES:π    'π    '   e = ESCπ%TOKEN.ESC          = 1π    '   [ = [π%TOKEN.BRACKET      = 2π    '   0 = 0,1,2,3,4,5,6,7,8,9π%TOKEN.DIGIT        = 3π    '   ; = ;π%TOKEN.SEMICOLON    = 4π    '   H = H,f,A,B,C,D,s,u,J,K,m,h,l,p,nπ%TOKEN.ANSI.COMMAND = 5π    '   " = "π%TOKEN.QUOTE        = 6π    '   < = ASCII code less than 32π%TOKEN.CONTROL.CODE = 7π    '   A = Standard A-Zπ%TOKEN.ASCII        = 8π    '   M = Mπ%TOKEN.MUSIC.STRING.START = 9π    '   # = ^Nπ%TOKEN.ANSI.MUSIC   = 10ππTokenTableData:ππ'        ASCII   Type     ASCII   TypeππDATA      "",    01,      "[",    02πDATA      "0",    03,      "1",    03πDATA      "2",    03,      "3",    03πDATA      "4",    03,      "5",    03πDATA      "6",    03,      "7",    03πDATA      "8",    03,      "9",    03πDATA      ";",    04,      "H",    05πDATA      "f",    05,      "A",    05πDATA      "B",    05,      "C",    05πDATA      "D",    05,      "s",    05πDATA      "u",    05,      "J",    05πDATA      "K",    05,      "m",    05πDATA      "h",    05,      "l",    05πDATA      "p",    05,      "R",    05πDATA      "n",    05,      "",    10πDATA      "M",    09,      "",    07πDATA      " ",    08,      "",    07πDATA      "",    07,      "",    07πDATA      "",    07,      "",    07πDATA      "",    07       "",     -1ππStateShiftTableData:ππ' WARNING:π'π'   Any tweaking of this table may be FATAL to the workingπ'   of this driver!  Unless you ABSOLUTELY understand whatπ'   you are doing, please DO NOT twiddle these bits!ππ'            e   [   0   ;   H   "   <   A   M   #πDATA   00,  01, 00, 00, 00, 00, 00, 09, 00, 00, 00πDATA   01,  00, 02, 00, 00, 00, 00, 00, 00, 00, 00πDATA   02,  00, 10, 03, 04, 05, 06, 10, 10, 11, 10πDATA   03,  10, 10, 03, 12, 05, 10, 10, 10, 10, 10πDATA   04,  10, 10, 12, 10, 10, 06, 10, 10, 10, 10πDATA   06,  07, 07, 07, 07, 07, 08, 07, 07, 07, 10πDATA   07,  07, 07, 07, 07, 07, 08, 07, 07, 07, 07πDATA   08,  10, 10, 10, 11, 05, 10, 10, 10, 10, 10πDATA   09,  01, 00, 00, 00, 00, 00, 09, 00, 00, 00πDATA   11,  10, 10, 11, 10, 11, 10, 10, 11, 11, 05ππ$IF %DEBUGπ    DIM AnsiGv AS SHARED GlobalVarTypeπ$ELSEπ    DIM AnsiGv AS SHARED GlobalVarTypeπ    EXTERNAL AnsiGvπ$ENDIFππDIM TokenTable(255)     AS SHARED INTEGERπDIM StateTable(13, 10)  AS SHARED INTEGERπDIM KeyTable(255)       AS SHARED STRINGπDIM MapActive(255)      AS SHARED INTEGERππDIM CharBuffer          AS SHARED STRINGπDIM IntStack(10)        AS SHARED INTEGERπDIM StrStack(10)        AS SHARED STRINGπDIM IntPtr              AS SHARED INTEGERπDIM StringPtr           AS SHARED INTEGERππDIM MusicBuffer(200)    AS SHARED STRINGπDIM BarPtr              AS SHARED INTEGERπDIM TopPtr              AS SHARED INTEGERππ'   DEBUG CODE STARTS HERE!ππ$IF %DEBUGππLansiSystemInitππCLSππOPEN "C:\DOS\TRM\UTILS\TERMINAT.LGO" FOR BINARY AS #1ππGET$ #1, LOF(1), Test$ππCLOSE #1ππFOR i = 1 TO LEN(Test$)ππ    LansiByteInterpret ASC(MID$(Test$, i, 1))ππNEXT iππDOππLOOP UNTIL LEN(INKEY$)ππ$ENDIFππENDππ'DEBUG CODE ENDS HERE!ππMusicHandler:π    INCR BarPtrπ    INCR TotChar, LEN(MusicBuffer(BarPtr))ππ    SELECT CASE BarPtrπ        CASE 201π            BarPtr = 1ππ        CASE TopPtrπ            PLAY "MF" + MusicBuffer(BarPtr)π            OverFlag = %TRUEπ            BarPtr = 0π            TopPtr = 0π            PLAY OFFππ    END SELECTππ    IF TopPtr > 1 THENπ        PLAY MusicBuffer(BarPtr)π    END IFππ    MusicBuffer(BarPtr) = ""ππRETURN  ' From MusicHandler:ππSUB LansiSystemInit () PUBLICππ    StateTableInitπ    TokenTableInitππEND SUBππSUB BarPush (Score AS STRING)ππINCR TopPtrππIF TopPtr = 201 THENπ    NotFirst = %TRUEπ    TopPtr = 1πEND IFππMusicBuffer(TopPtr) = ScoreππIF TopPtr = 1 AND NOT NotFirst THENπ    PLAY "MBT255N0N0N0T120"πEND IFππEND SUBππSUB ControlCodeReact (code AS INTEGER)ππ%CONT.CTRL.D    = 4π%CONT.CTRL.E    = 5π%CONT.CTRL.G    = 7π%CONT.BACKSPACE = 8π%CONT.TAB       = 9π%CONT.PAGEFEED  = 12π%CONT.CTRL.S    = 19π%CONT.CTRL.X    = 24ππSELECT CASE codeπ    CASE %CONT.CTRL.Eπ        CursorUp 1ππ    CASE %CONT.CTRL.Xπ        CursorDown 1ππ    CASE %CONT.CTRL.Dπ        CursorRight 1ππ    CASE %CONT.CTRL.Sπ        CursorLeft 1ππ    CASE %CONT.CTRL.Gπ        IF AnsiGv.Speaker THENπ            SOUND AnsiGv.BeepHz, AnsiGv.BeepDurπ        END IFππ    CASE %CONT.PAGEFEEDπ        LansiScreenClearπ   π    CASE %CONT.BACKSPACEπ        IF AnsiGv.DesBackspace THENπ            IF AnsiGv.Y > 1 THENπ                DECR AnsiGv.Yπ                CursorLocate AnsiGv.X, AnsiGv.Yπ                sqjPRINT 32, %HIGH.LEVEL' Print a spaceπ                DECR AnsiGv.Yπ                CursorLocate AnsiGv.X, AnsiGv.Yπ            END IFπ        END IFππ    CASE %CONT.TABπ        IF AnsiGv.ExpandTab THENπ            IF AnsiGv.Y + AnsiGv.TabStep < 79 THENπ                FOR i = 1 TO AnsiGv.TabStepπ                    sqjPRINT 32, %LOW.LEVELπ                NEXT iπ            END IFπ        ELSEπ            sqjPRINT 32, %HIGH.LEVELπ        END IFπEND SELECTππEND SUBππSUB CursorDown (RowsDown AS INTEGER)ππIF IntPtr = 0 THENπ    RowsDown = 1πEND IFππTempX = AnsiGv.X + RowsDownππIF TempX > AnsiGv.ScreenHeight THENπ    TempX = AnsiGv.ScreenHeightπEND IFππAnsiGv.X = TempXππCursorLocate AnsiGv.X, AnsiGv.YππEND SUBππSUB CursorLeft (ColsLeft AS INTEGER)ππIF IntPtr = 0 THENπ    ColsLeft = 1πEND IFππTempY = AnsiGv.Y - ColsLeftπIF TempY < 1 THENπ    TempY = 1πEND IFππAnsiGv.Y = TempYππCursorLocate AnsiGv.X, AnsiGv.YππEND SUBππSUB CursorLocate (X AS INTEGER,_π                     Y AS INTEGER)ππIF Y > AnsiGv.ScreenWidth THENπ    Y = 1π    IF AnsiGv.LineWrap THENπ        INCR Xπ    END IFπELSEπ    IF Y < 1 THENπ        Y = 1π    END IFπEND IFππIF X > AnsiGv.ScreenHeight THENπ    EXIT SUBπELSEπ    IF X < 1 THENπ        X = 1π    END IFπEND IFππAnsiGv.X = XπAnsiGv.Y = YππIF AnsiGv.CursorVis THENπ    LOCATE AnsiGv.X, AnsiGv.Y, AnsiGv.CursorVis, 6, 7πEND IFππEND SUBππSUB CursorRestoreππIF AnsiGv.SavedFlag THENπ    CursorLocate AnsiGv.OldX, AnsiGv.OldYπEND IFππEND SUBππSUB CursorRight (ColsRight AS INTEGER)ππIF IntPtr = 0 THENπ    ColsRight = 1πEND IFππTempY = AnsiGv.Y + ColsRightπIF TempY > AnsiGv.ScreenWidth THENπ    TempY = AnsiGv.ScreenWidthπEND IFππAnsiGv.Y = TempYππCursorLocate AnsiGv.X, AnsiGv.YππEND SUBππSUB CursorSaveππAnsiGv.SavedFlag = %TRUEππAnsiGv.OldX = AnsiGv.XπAnsiGv.OldY = AnsiGv.YππEND SUBππSUB CursorUp (RowsUp AS INTEGER)ππIF IntPtr = 0 THENπ    RowsUp = 1πEND IFππTempX = AnsiGv.X - RowsUpππIF TempX < 1 THENπ    TempX = 1πEND IFπ   πAnsiGv.X = TempXππCursorLocate AnsiGv.X, AnsiGv.YππEND SUBππSUB EOLEraseππCursorSaveππCursorVis = AnsiGv.CursorVisπAnsiGv.CursorVis = %FALSEππFOR Ptr = AnsiGv.Y TO AnsiGv.ScreenWidthπ    sqjPRINT 0, %LOW.LEVELπNEXT PtrππAnsiGv.CursorVis = CursorVisπCursorRestoreππCursorLocate AnsiGv.X, AnsiGv.YππEND SUBππSUB IntPushππIF LEN(CharBuffer) THENπ    INCR IntPtrπ    IntStack(IntPtr) = VAL(CharBuffer)π    CharBuffer = ""πEND IFππEND SUBππSUB KeyboardMap (KeyCode AS INTEGER,_π                    Redefinition AS STRING)ππSELECT CASE KeyCodeπ    CASE 8474   ' Not a key!  This is the VisiPlex flag!π                ' "8474" is "VISI" dialed on a phone...ππ        IF LEFT$(Redefinition, 10) = "VisiPlex V" THENπ            AnsiGv.VisiPlex = %TRUEπ            AnsiGv.MapActive = %FALSEπ            AnsiGv.VisiVersion = VAL(MID$(Redefinition, 11))π        END IFππ    CASE ELSEπ        SELECT CASE AnsiGv.VisiPlexπ            CASE %TRUEπ                VisiPlexComReact KeyCode, Redefinitionππ            CASE %FALSEπ                IF KeyCode < 256 THENπ                    KeyTable(KeyCode) = Redefinitionπ                    MapActive(KeyCode) = %TRUEπ                END IFππ        END SELECTπEND SELECTππEND SUBππSUB LinewrapDisableππAnsiGv.LineWrap = %FALSEππEND SUBππSUB MusicPlay (Score AS STRING)ππSELECT CASE AnsiGv.Musicπ    CASE %TRUEπ        IF AnsiGv.Speaker THENπ            sqjPLAY Scoreπ        END IFππ    CASE %FALSEπ        FOR i = 1 TO LEN(Score)π            sqjPRINT ASC(MID$(Score, i, 1)), %LOW.LEVELπ        NEXT iπ        sqjPRINT 14, %LOW.LEVELππEND SELECTππEND SUBππSUB sqjPLAY (Score AS STRING)ππScore = UCASE$(MID$(Score,2))ππSELECT CASE INSTR(Score, "MB")π    CASE 0π        PLAY Scoreππ    CASE ELSEπ        ON PLAY(3) GOSUB MusicHandlerπ        PLAY ONπ        BarPush ScoreππEND SELECTππEND SUBππSUB sqjPRINT (Bite AS INTEGER,_π              Level AS INTEGER)ππSELECT CASE Level * MapActive(Bite) * AnsiGv.MapActiveπ    CASE 0π        SELECT CASE Biteπ            CASE 13π                AnsiGv.Y = 1ππ            CASE 10π                IF AnsiGv.X < AnsiGv.ScreenHeight THENπ                    INCR AnsiGv.Xπ                ELSEπ                    '   This forces a screen scrollπ                    LOCATE AnsiGv.ScreenHeight + 1, 1π                    PRINTπ                END IFππ            CASE ELSEπ                FPRINT Biteπ                INCR AnsiGv.Yππ        END SELECTππ    CASE ELSEπ        FOR i = 1 TO LEN(KeyTable(Bite))π            sqjPRINT ASC(MID$(KeyTable(Bite), i, 1)), %LOW.LEVELπ        NEXT iππEND SELECTππCursorLocate AnsiGv.X, AnsiGv.YππEND SUBππSUB RemoteCursorSet (X AS INTEGER,_π                        Y AS INTEGER)ππ'   This information is mostly useless, and is received asπ'   a result of sending a ESC[6n sequence....ππAnsiGv.RemoteX = XπAnsiGv.RemoteY = YππEND SUBππSUB ScreenAttrReact ()ππSELECT CASE AnsiGv.Reversedπ    CASE %TRUEπ        TempFore = AnsiGv.BackColorπ        TempBack = AnsiGv.ForeColorππ    CASE %FALSEπ        TempFore = AnsiGv.ForeColorπ        TempBack = AnsiGv.BackColorππEND SELECTππIF AnsiGv.Bold THENπ    TempFore = TempFore + 8πEND IFππIF AnsiGv.Concealed THENπ    TempFore = TempBackπ    '   Version 3.1 fix... turns off cursor by forceπ    LOCATE , , 0πELSEπ    '   Otherwise, we must turn the cursor on by forceπ    LOCATE , , 1πEND IFππAnsiGv.ColorAttr = TempBack * 16 + TempForeππIF AnsiGv.Blink THENπ    BIT SET AnsiGv.ColorAttr, 7πEND IFππCOLOR TempFore, TempBackππEND SUBππSUB ScreenAttrSet (Attribute AS INTEGER)ππSELECT CASE Attributeπ    CASE 0π        AnsiGv.Bold     = %FALSEπ        AnsiGv.Blink    = %FALSEπ        AnsiGv.Reversed = %FALSEπ        AnsiGv.Concealed= %FALSEπ        AnsiGv.ForeColor= 7π        AnsiGv.BackColor= 0ππ    CASE 1π        AnsiGv.Bold     = %TRUEππ    CASE 5π        AnsiGv.Blink    = %TRUEππ    CASE 7π        AnsiGv.Reversed = %TRUEππ    CASE 8π        AnsiGv.Concealed= %TRUEππ    CASE %ANSI.F.BLACKπ        AnsiGv.ForeColor= 0ππ    CASE %ANSI.F.REDπ        AnsiGv.ForeColor= 4ππ    CASE %ANSI.F.GREENπ        AnsiGv.ForeColor= 2ππ    CASE %ANSI.F.YELLOWπ        AnsiGv.ForeColor= 6ππ    CASE %ANSI.F.BLUEπ        AnsiGv.ForeColor= 1ππ    CASE %ANSI.F.MAGENTAπ        AnsiGv.ForeColor= 5ππ    CASE %ANSI.F.CYANπ        AnsiGv.ForeColor= 3ππ    CASE %ANSI.F.WHITEπ        AnsiGv.ForeColor= 7ππ    CASE %ANSI.B.BLACKπ        AnsiGv.BackColor= 0ππ    CASE %ANSI.B.REDπ        AnsiGv.BackColor= 4ππ    CASE %ANSI.B.GREENπ        AnsiGv.BackColor= 2ππ    CASE %ANSI.B.YELLOWπ        AnsiGv.BackColor= 6ππ    CASE %ANSI.B.BLUEπ        AnsiGv.BackColor= 1ππ    CASE %ANSI.B.MAGENTAπ        AnsiGv.BackColor= 5ππ    CASE %ANSI.B.CYANπ        AnsiGv.BackColor= 3ππ    CASE %ANSI.B.WHITEπ        AnsiGv.BackColor= 7ππEND SELECTππAnsiGv.ColorAttr = AnsiGv.ForeColor + AnsiGv.BackColor * 16ππEND SUBππSUB LansiScreenClear () PUBLICππAnsiGv.X = 1πAnsiGv.Y = 1ππCOLOR AnsiGv.ForeColor, AnsiGv.BackColorππCLS TEXTππCursorLocate AnsiGv.X, AnsiGv.YππEND SUBππSUB ScreenModeSet (Mode AS INTEGER)ππSELECT CASE Modeπ    CASE 0, 1π        ScreenWidthSet 40ππ    CASE 2, 3π        ScreenWidthSet 80ππ    CASE 7π        AnsiGv.LineWrap = %TRUEππEND SELECTππEND SUBππSUB ScreenWidthSet (Columns AS INTEGER)ππWIDTH Columns, 25ππAnsiGv.ScreenWidth = ColumnsππEND SUBππSUB StateReact (Bite AS INTEGER)ππSELECT CASE AnsiGv.STATEπ    CASE %STATE.NORMALπ        sqjPRINT Bite, %HIGH.LEVELππ    CASE %STATE.READ.ESCπ        ' No need to "do" anything.ππ    CASE %STATE.IN.ANSIπ        ' No need to "do" anything.ππ    CASE %STATE.IN.INT.PARAMπ        CharBuffer = CharBuffer + CHR$(Bite)ππ    CASE %STATE.READ.SEMICOLONπ        IntPushπ        AnsiGv.STATE = %STATE.IN.ANSIπ        StateReact 0ππ    CASE %STATE.READ.ANSI.COMMANDπ        SELECT CASE CHR$(Bite)π            CASE "H", "f"π                IntPushπ                SELECT CASE IntPtrπ                    CASE 2π                        CursorLocate IntStack(1), IntStack(2)ππ                    CASE 1π                        '   I added this during the debugging of v3.0π                        '   since I had overlooked it for some reason....π                        CursorLocate IntStack(1), 1ππ                    CASE 0π                        CursorLocate 1, 1ππ                END SELECTπ                IntPtr = 0ππ            CASE "A"π                IntPushπ                CursorUp IntStack(1)π                IntPtr = 0ππ            CASE "B"π                IntPushπ                CursorDown IntStack(1)π                IntPtr = 0ππ            CASE "C"π                IntPushπ                CursorRight IntStack(1)π                IntPtr = 0ππ            CASE "D"π                IntPushπ                CursorLeft IntStack(1)π                IntPtr = 0ππ            CASE "s"π                CursorSaveππ            CASE "u"π                CursorRestoreππ            CASE "J"π                IntPushπ                LansiScreenClearπ                IntPtr = 0ππ            CASE "K"π                EOLEraseππ            CASE "m"π                IntPushπ                FOR Ptr = 1 TO IntPtrπ                    ScreenAttrSet IntStack(Ptr)π                    '   This was moved here to fix a glitch sinceπ                    '   [0;xxx was not read properlyπ                    ScreenAttrReactπ                NEXT Ptrππ                IntPtr = 0ππ            CASE "h"π                IntPushπ                ScreenModeSet IntStack(1)π                IntPtr = 0ππ            CASE "l"π                IntPushπ                '   Version 3.1 fix -- all modes except 7 act asπ                '   with "h" commandπ                SELECT CASE InStack(1)π                    CASE 7π                        LinewrapDisableππ                    CASE ELSEπ                        ScreenModeSet IntStack(1)ππ                END SELECTππ            CASE "p"π                IntPushπ                SELECT CASE IntPtrπ                    CASE 1π                        KeyboardMap IntStack(1), StrStack(1)π                        StringPtr   = 0ππ                    CASE 2π                        KeyboardMap IntStack(1), CHR$(IntStack(2))ππ                END SELECTππ                IntPtr      = 0ππ            CASE "n"π                IntPushπ                SystemReqReact IntStack(1)π                IntPtr = 0ππ            CASE ""π                StringPushπ                MusicPlay StrStack(1)π                StringPtr = 0ππ            CASE "R"π                IntPushπ                RemoteCursorSet IntStack(1), IntStack(2)π                IntPtr = 0ππ        END SELECTππ        AnsiGv.STATE = %STATE.NORMALππ    CASE %STATE.READ.OPEN.QUOTEππ    CASE %STATE.IN.STRING.LITERALπ        CharBuffer = CharBuffer + CHR$(Bite)ππ    CASE %STATE.READ.CLOSE.QUOTEπ        StringPushππ    CASE %STATE.READ.CONTROL.CODEπ        ControlCodeReact Biteππ    CASE %STATE.ERROR.RESET.ANSIπ        IntPtr      = 0π        StringPtr   = 0π        CharBuffer  = ""π        sqjPRINT Bite, %LOW.LEVELπ        AnsiGv.STATE = %STATE.NORMALππ    CASE %STATE.IN.MUSICπ        CharBuffer = CharBuffer + CHR$(Bite)ππ    CASE %STATE.INTEGER.PUSHπ        IntPushπ        AnsiGv.STATE = %STATE.IN.ANSIππ    CASE %STATE.STRING.PUSHπ        StringPushπ        AnsiGv.STATE = %STATE.IN.ANSIππEND SELECTππEND SUBππSUB StateTableInit ()ππRESTORE StateShiftTableDataππDIM Tkn(1 TO 10)ππFOR STATE = 0 TO 10π    READ STATEπ    READ Tkn(1),_π         Tkn(2),_π         Tkn(3),_π         Tkn(4),_π         Tkn(5),_π         Tkn(6),_π         Tkn(7),_π         Tkn(8),_π         Tkn(9),_π         Tkn(10)ππ    FOR TokenType = 1 TO 10π        StateTable(STATE, TokenType) = Tkn(TokenType)π    NEXTππNEXT STATEππEND SUBππSUB StringPushππINCR StringPtrπStrStack(StringPtr) = CharBufferπCharBuffer = ""ππEND SUBππSUB SystemReqReact (Request AS INTEGER)ππSELECT CASE Requestπ    CASE 6π        ' Request cursor position!π        ' Put code here that sends cursor position in format:π        'π        '       $e[xx;yyRππ    CASE ELSEπ        ' DOS's %ANSI.SYS responds just as above!ππEND SELECTππEND SUBππSUB TokenTableInit ()ππ' Set some default start up values for the global system variablesπ' These will suffice for most purposes.ππAnsiGv.X            = 1πAnsiGv.Y            = 1πAnsiGv.ScreenWidth  = 80πAnsiGv.ScreenHeight = 24πAnsiGv.DesBackspace = %TRUEπAnsiGv.ExpandTab    = %TRUEπAnsiGv.TabStep      = 5πAnsiGv.LineWrap     = %TRUEπAnsiGv.ForeColor    = 7πAnsiGv.BackColor    = 0πAnsiGv.ColorAttr    = &H07πAnsiGv.CursorVis    = 1πAnsiGv.Music        = %TRUEπAnsiGv.Speaker      = %TRUEπAnsiGv.BeepHz       = 300πAnsiGv.BeepDur      = 3πAnsiGv.MapActive    = %TRUEππIF (pbvScrnCard AND 1) = 0 THENπ    AnsiGv.ScreenSeg = &HB800        ' color monitorπELSEπ    AnsiGv.ScreenSeg = &HB000        ' mono monitorπEND IFππRESTORE TokenTableDataππFOR i = 0 TO 255π    TokenTable(i) = %TOKEN.ASCIIπ    KeyTable(i) = CHR$(i)π    MapActive(i) = %FALSEπNEXT iππTokenTable(9)  = 7πTokenTable(10) = 8πTokenTable(34) = 6ππDOπ    READ Char$, TokenTypeπ    IF TokenType > 0 THENπ        TokenTable(ASC(Char$)) = TokenTypeπ    ELSEπ        EXIT DOπ    END IFπLOOPππCursorLocate AnsiGv.X, AnsiGv.YππEND SUBππSUB VisiPlexComReact (ComType AS INTEGER,_π                         VisiCommand AS STRING)ππ' VisiPlex driver goes here and responds to the specific VisiPlexπ' commands that will be standardized later!  Until then, you'll justπ' have to wait.π'π' It will be a simple matter of doing this here:π'π'       VisiDriver ComType, VisiCommandπ'π' AND BINGO!  Instant support!ππEND SUBππSUB LansiByteInterpret (BYVAL Bite AS INTEGER) PUBLICππAnsiGv.STATE = StateTable(AnsiGv.STATE, TokenTable(Bite))ππStateReact BiteππEND SUBππSUB FPRINT(BYVAL Char AS INTEGER)ππ    ScrnSeg = AnsiGv.ScreenSegππ    ! push DS                 ; save DS for PowerBASICππ    ! mov  AX, ScrnSeg        ; put screen segment in AXπ    ! mov  ES, AX             ; move to ESππ    Row = AnsiGv.Xπ    ! mov  AX, Row            ; put row in AXπ    ! dec  AX                 ; minus oneπ    ! mov  CX, 160            ; AX =π    ! mul  CX                 ;   AX * 160π    ! mov  DI, AX             ; put it in DIπ    Col = AnsiGv.Yπ    ! mov  AX, Col            ; put column in AXπ    ! dec  AX                 ; minus oneπ    ! shl  AX, 1              ; times 2π    ! add  DI, AX             ; add to DIππ    Attr = AnsiGv.ColorAttrπ    ! mov  AH, Attr           ; put attribute in AHπ    ! mov  AL, CharππWriteChar:π    ! stosw                   ; write char and attribute to screenπQPExit:π    ! pop  DS                 ; restore DS for PowerBASICππEND SUBπDamond Walker                  SIEVE OF ERATOSTHENES          PRIME,NUMBER,GENERATOR         Unknown Date           ASIC                   66   1595     SIEVE.ASI   rem ********************************πrem *** ASIC version of Classic  ***πrem ***  Sieve of Eratosthenes   ***πrem ***      Benchmark           ***πrem ***   by Damond Walker       ***πrem *** [e-mail] ***πrem ********************************πrem *** Adapted from:            ***πrem ***    Byte Magzine          ***πrem ***    September, 1981       ***πrem ***    Pages 180-189         ***πrem ********************************πrem *** Timings:                 ***πrem ***  486dx4-100    0.494     ***πrem ***  PS/2 Mod 50Z 11.485     ***πrem ***   ('286-10)              ***πrem ***                          ***πrem *** Times are in seconds.    ***πrem ********************************ππDIM Flags(8190)ππCLSπPRINT "Sieve - 25 iterations"πX& = TIMERππFOR Iter = 1 TO 25π  Count = 0ππ  FOR I = 0 TO 8190π    Flags(I) = 1π  NEXT Iππ  FOR I = 0 TO 8190π    IF Flags(I) = 1 THENπ       Prime = I + Iπ       Prime = Prime + 3π       K = I + Primeπ       WHILE K <= 8190π         Flags(K) = 0π         K = K + Primeπ       WENDπ       Count = Count + 1π    ENDIFπ  NEXT IπNEXT IterππXX& = TIMERππSeconds@ = xx& - x&πSeconds@ = Seconds@ / 18.2@πSeconds$ = str$(Seconds@)πSeconds$ = ltrim$(Seconds$)ππprint Count;πprint " primes in ";πprint Seconds$;πprint " seconds."ππENDππrem Note:- To get this to compile, you have to set Decimal & Extended math on.πrem As the remarks show up top, my 486dx4-100 ran the thing in less than aπrem second while my PS/2 Mod 50Z ('286-10) ran the sucker in 11.5 seconds.πrem -: MoribundππPhil Wright                    DRAW BOX DEMO                  DRAW,BOX,DEMO                  Unknown Date           ASIC                   116  2451     DRAWBOX.ASI REM drawbox.asi for ASIC 5.0πREM ported from original QBasic source code written by:πREM [e-mail] <Phil Wright> *Thanks Mate!*ππCLSππCOLOR 0, 7πfor i = 1 to 26πa$ = string$(80, " ")πprint a$πnext iππREM Message may be resized and the box will fit it (keep it divisible by 2).πMessage$ = " This is<---------->a re-sizable<------------>screen "ππGOSUB PrintMessage:πGOSUB Constants:πGOSUB DrawTopBox:πGOSUB Constants:πGOSUB DrawSidesBox:πGOSUB Constants:πGOSUB DrawBotBox:πGOSUB SaveScreen:πGOSUB MessageTimer:πENDππPrintMessage:π   REM was> LOCATE 12, 40 - (LEN(Message$) / 2)π      Col = LEN(Message$)π      Col = Col / 2π      Col = 40 - Colπ   LOCATE 12, Colπ   PRINT Message$πRETURNππConstants:π   UpRow = 11π       REM was> UpCol = 40 - LEN(Message$) / 2 + 1π       UpCol = LEN(Message$)π       UpCol = UpCol / 2π       UpCol = UpCol + 1π   UpCol = 40 - UpColπ   LoRow = 13π       REM was> LoCol = 40 + LEN(Message$) / 2π       LoCol = LEN(Message$π       LoCol = LoCol / 2π   LoCol = 40 + LoColπ   Back = 1π   Fore = 7πRETURNπππDrawTopBox:πCOLOR Fore, BackπLOCATE UpRow, UpColπREM was> PRINT CHR$(218) + STRING$(LoCol - UpCol - 1, CHR$(196)) + CHR$(191)π   A$ = CHR$(218)π   B = LoCol - UpColπ   B = B - 1π   C$ = CHR$(196)π   D$ = CHR$(191)π   X$ = STRING$(B, C$)π   A$ = A$ + X$π   A$ = A$ + D$πPRINT A$πRETURNππDrawSidesBox:πREM was> FOR Z = (UpRow + 1) TO (LoRow - 1)π   REM prime the FOR/NEXT loopπ   UpRow = UpRow + 1π   LoRow = LoRow - 1πFOR Z = UpRow TO LoRowπ       LOCATE Z, UpColπ       REM was> PRINT CHR$(179)π           W$ = CHR$(179)π       PRINT W$π       LOCATE Z, LoColπ       REM was> PRINT CHR$(179)π           U$ = CHR$(179)π       PRINT U$π   NEXT ZπRETURNππDrawBotBox:πLOCATE LoRow, UpColπREM was> PRINT CHR$(192) + STRING$(LoCol - UpCol - 1, CHR$(196)) + CHR$(217)π   A$ = CHR$(192)π   B = LoCol - UpColπ   B = B - 1π   C$ = CHR$(196)π   D$ = CHR$(217)π   X$ = STRING$(B, C$)π   A$ = A$ + X$π   A$ = A$ + D$πPRINT A$πRETURNππSaveScreen:πDEFSEG = &hexB800πBSAVE "screen", 0, 4000πRETURNππMessageTimer:πREM 5 sec. timer routine from original QBasic source code written by:πREM [e-mail] (Glen Blankenship)πREM (5 * 18.2 clock-ticks-per-second = 91)πTickOne = TIMERπFOR i = 1 TO 91π   TickTwo = TickOneπ   WHILE TickTwo = TickOneπ       TickOne = TIMERπ   WENDπNEXT iπRETURNππKenneth W. Melvin              MENU IN A BOX                  [e-mail]           08-20-95 (00:00)       ASIC                   127  3510     BOXMENU.ASI REM BOXMENU.ASI 08/20/95 kwmπREM Demonstrates a simple, structured, Menu-in-a-box.πREM For ASIC 5.0.ππREM *******************************************************************πREM *********************** Main Program Module ***********************πREM *******************************************************************πCLSπCOLOR 1, 7π   GOSUB MakeBox:π   GOSUB PrintMessage:π   GOSUB Menu:πENDππREM *******************************************************************πREM *** This module draws the box on the screen and is divided into ***πREM *** three smaller modules which draw different parts of the box ***πREM *******************************************************************πMakeBox:π   GOSUB UpperBox:π   GOSUB BoxSides:π   GOSUB LowerBox:πRETURNππREM *******************************************************************πREM ********** This sub-module draws the top of the box ***************πREM *******************************************************************πUpperBox:π   LOCATE 8, 24π       A$ = SPACE$(23)π       B$ = CHR$(201)π       C$ = CHR$(187)π       D$ = B$ + A$π       D$ = D$ + C$π   PRINT D$π   LOCATE 8, 25π       A$ = SPACE$(21)π       B$ = CHR$(205)π       C$ = B$ + A$π       C$ = C$ + B$π   PRINT C$πRETURNππREM *********************************************************************πREM ************ This sub-module draws the sides of the box *************πREM *********************************************************************πBoxSides:π   J = 9π   FOR I = 1 TO 5π       LOCATE J, 24π           A$ = SPACE$(23)π           B$ = CHR$(186)π           C$ = B$ + A$π           C$ = C$ + B$π       PRINT C$π       J = J + 1π   NEXT IπRETURNππREM ********************************************************************πREM *********** This sub-module draws the bottom of the box ************πREM ********************************************************************πLowerBox:π   LOCATE 14, 24π       A$ = SPACE$(23)π       B$ = CHR$(200)π       C$ = CHR$(188)π       D$ = B$ + A$π       D$ = D$ + C$π   PRINT D$π   LOCATE 14, 25π       E$ = STRING$(23, 205)π   PRINT E$πRETURNππREM **********************************************************************πREM ******************** This module prints your message *****************πREM **********************************************************************πPrintMessage:π   LOCATE 8, 26π           print "      MAIN MENU      "π   LOCATE 10, 26π           print "  [A] First Choice   "π   LOCATE 11, 26π           print "  [B] Second Choice  "π   LOCATE 12, 26π           print "  [C] Third Choice   "π   LOCATE 13, 26π           print "  [X] Exit this Menu "πRETURNππREM ***********************************************************************πREM ************************* Menu Module *********************************πREM ***********************************************************************πMenu:πlocate 16, 0πcolor 7, 0πprint "Choose..."πinput Choice$πif Choice$ = "A" then FirstChoice:πif Choice$ = "a" then FirstChoice:πif Choice$ = "B" then SeconChoice:πif Choice$ = "b" then SeconChoice:πif Choice$ = "C" then ThirdChoice:πif Choice$ = "c" then ThirdChoice:πif Choice$ = "X" then End:πif Choice$ = "x" then End:ππFirstChoice:π locate 18,0π print "You chose A"π goto Menu:ππSeconChoice:π locate 18,0π print "You chose B"π goto Menu:ππThirdChoice:π locate 18,0π print "You chose C"π goto Menu:ππEnd:π endπππKenneth W. Melvin              ASCII CHARACTER TABLE          [e-mail]           08-20-95 (00:00)       ASIC                   82   3146     ASCIDATA.ASI       REM Filename: ASICDATA.ASI for ASIC v5.0π       REM Date: 20 August 1995 kwmππREM ***********************************************************************πREM ********************** Main Program Module ****************************πREM ***********************************************************************πDATA 32,33,34,35,36,37,38,39,40,41,42,43,44,45,46,47πDATA 48,49,50,51,52,53,54,55,56,57,58,59,60,61,62,63πDATA 64,65,66,67,68,69,70,71,72,73,74,75,76,77,78,79πDATA 80,81,82,83,84,85,86,87,88,89,90,91,92,93,94,95πDATA 96,97,98,99,100,101,102,103,104,105,106,107,108,109,110,111πDATA 112,113,114,115,116,117,118,119,120,121,122,123,124,125,126,127πDATA 128,129,130,131,132,133,134,135,136,137,138,139,140,141,142,143πDATA 144,145,146,147,148,149,150,151,152,153,154,155,156,157,158,159πDATA 160,161,162,163,164,165,166,167,168,169,170,171,172,173,174,175πDATA 176,177,178,179,180,181,182,183,184,185,186,187,188,189,190,191πDATA 192,193,194,195,196,197,198,199,200,201,202,203,204,205,206,207πDATA 208,209,210,211,212,213,214,215,216,217,218,219,220,221,222,223πDATA 224,225,226,227,228,229,230,231,232,233,234,235,236,237,238,239πDATA 240,241,242,243,244,245,246,247,248,249,250,251,252,253,254,255πDATA 00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00π       CLSπ       COLOR 7, 0π       GOSUB PrintTitle:π       GOSUB Start:π       ENDππREM ***********************************************************************πREM ********************** Title Screen Module ****************************πREM ***********************************************************************πPrintTitle:π       WIDTH 40π       CLSπ       LOCATE 10, 18π           PRINT "ASCII"π       LOCATE 11, 16π           PRINT "CHARACTER"π       LOCATE 12, 18π           PRINT "TABLE"π       LOCATE 23, 13π           PRINT "<Press any key>"π       GOSUB Pause:π       WIDTH 80πRETURNππREM ***********************************************************************πREM ******************** Press-A-Key Pause Routine ************************πREM ***********************************************************************πPause:π       inky$ = INKEY$π       IF inky$ = "" THEN Pause:πRETURNππREM ***********************************************************************πREM ********************* Ascii Character Table Module ********************πREM ***********************************************************************πStart:πREM This program displays the ASCII characters 32-255.πREM 32 is Space, and 255 is Blank, so a character will not show for them.ππCLSπFOR Ascii = 1 TO 240π   LOCATE 4, 0π      FOR ShowChar = 1 TO 16π           READ Asciiπ           PRINT Ascii;π           PRINT "= ";π           Strg$ = CHR$(Ascii)π           PRINT Strg$π      NEXT ShowCharπ   LOCATE 23, 0π   PRINT "<Press a key>"π   GOSUB Pause:π   CLSπNEXT AsciiπRETURNππREM The first FOR/NEXT iteration supplies the READ statement with fodder.πREM The second FOR/NEXT iteration displays the data to the screen, 16πREM characters at a time. The use of the Pause subroutine allows the userπREM to look at each screen.ππMatt Pritchard                 COMPLETE MODE X ROUTINES       Software Vault CD-ROM          03-30-93 (03:00)       ASM, QB, PDS           296  19508    MODEX.BAS   '>>> Page 1 of MODEX.ZIP begins here. TYPE:BINAA TLEN:14284πDEFINT A-Z:DIM SHARED K,S,B&,Z&:V1 'Created by PostIt! 7.1πSUB V1:OPEN "O",1,"MODEX.ZIP",4^6:Z&=14284:?STRING$(50,177);πU"%up()%9%%%%-%%=AM?U,5vrvRd%%qW%%%.%%%%rt.ij'S[fxrfhL<FTs[KapVmbπU"xOQVUuEez]aeU]-48mTJC/>)RKH?C*Mb2JK7.-/qiG*n_yAupDvd/fXGFU%Q+3:πU"$L2\WW<[_(=/%1n5+l?8r<XAt$,'Ta?g]W(>HrAWK[_Z%>rN^/ZKc1RnL1]6vqmπU"eXpq(#=tGuY+J6]mB#xdm?YLDE2la#9jK:S?Qwn[a(E+QxAA8lB/A;32Eb[](atπU"ByoCYgwAj8F5JS,5W5Nf>qG*gvf9AaEFb+Mmx_^F8iKQ%V1Hmb0?RHL2D39hhe%πU"/-qr*sr+Xu8cIwLUoqe0Iq;#C=#tl^A\8W.)]v>CfDI\*0pBXe<tUUlcD%x+:q7πU"Ol+[e=K;lDhh:<b^]*&_EJ5FJA[OFPcSK:]JL,RI%?>S\RW>RiBQp-8o#mlo7\[πU"0<lDI9C-jF0oBQ_6R%wE\gsQaYRFXJ44.KHl[#aZve9ekCA(oS9^(_DUn)2iwuMπU")<HMd^mLRq4Qwo<T<MEd'roW5HkMAhL$eFbu4BWCTU+&.Lrocmb2<_sY$'_4w\;πU"n>Ub(p(u4jU0jm[Eu$2WGCkN#xKp\R]hWO8BN]'A.rnMFhy2;3'AVSkFJMM/[KOπU"3&3jUYgO2JgK5?iStKIHBE)_zgK//(-eE.2>8eHmdX/bMF4Li=[7Y_oe6.oJ-s(πU"0w)4^+V[h1C6i'XUPhK'GSI=2)s=\a,\kFCjDt=XFXCqc\=]wohh3<Xbt:'v'HtπU"g68kQafkUkxezc:yzNxua[<&=tGaaGYh.>jIYk:PoX=+OZLGe-<f[&=1Y+vJlY\πU"REd4o0G8K]iHF=clsY(SZ)SMK/0w>;PeVbXv'>Y=L7*uH3N3fRI3mNeYpA6,.l9πU"3Mcm8(o&[2;#oJq]4o-Fwe#qgP3Ci)(Z;/O-t13Bpc&ADMAd_bA$<$/JVan#/^1πU"rOBI,[E>#m9Xch&\.UKaI_1w\aAUpvMCh_f.Z*efo4slcc+XC-o'APf]DF4kaF,πU";]%W3wo,kBI[R+,iM$D#^-L%NvR$pxd*Ofp)l+PP>]\(<LC5KxtfQ8B)$O.%vs6πU"awjpkPxhLf4_B5t..RP$>0cl7<^MpU+Pa5S/?=mAOey<M/1ozG-#^>fN='&))n;πU",WsPm5/MmXau_W9bs4'U/HP4_</ZFjx%cI51%fW$ID=_Q5Kwb;',k+J$I2/lCE3πU"q8FBFs_$o9*J8G9-,mIoSqjCk_KsHs3kq.#W+ip.HH$r;&:bGCQ'wcI#'S5hFo,πU"L+a?E[rLKaOzp+QeeQoWI8d'vjstKhhyJK%k[6.VA2BYvSoye$m^-gg]F2DMC#lπU"(T8IR^i*Nyz+6,^;L6pZG?:l0-qc+j8C5^7fZd)U'lDKd)+'GVW5k']kvT_':*3πU"I#?8,[Br92Re_uAprIqurr>RC:7.m(gY,w476Sr<YIA,[d3ujjnkp]+%Q+^9G%.πU"[quRfeHeAhA1*KrtSWokA#AKY0pQTv=r3[6ccr0YJg_w$u_cL3_9D^bj%n7%',WπU"r'E=)qI0DMv?G),Q4.-7]yp%LI/n(W]N24*mw%06Lpl%4g4X$uW+6).]_h.k3+%πU"%bM,B28oGE0n*z/au/rJR2$.1,xBL9EMUMFXtsVZaCj+VdcMZ$W&eTA?BOgc7O1πU"W[N/aQLs,QbHoiT(Rt>.G(sSTgY79^nJq$JG3]81KbX9)YYe>5a?ALo8qU(NW*FπU"81<K\uX*s--Nc^gB'Vwdef^o56]c+H0LYVF+E$]F\17i]*:Ab(p?^k8hT7&.-FUπU"I8'juD-93\\[.r81P]YxTD-wdmpGx;ArQTPwN&K3s'.11+j*%$2*[y&a4U$]XbaπU"A<Z+6gJ>OT\gU6bemqsIV7q$?83SpD)rMoP%p#G8i.#q>-mtZ&l:Y?*Rm&nJ3H3πU"oDf6OrB(o0P<S+&*E/fO'Hv^yIlBE^;^P#;1fjKQE*,hP#l3a)U#G=P<NpHC2S5πU"AUJVaBU:70twB&e?O#l#&zFm\><PEV%MWCB?lIym>X)Vp.A<Vr09&&B)mTDtgX7πU"XCLI16O*B<1xWrn8muRd1Tqe0[QEplALSq.Vuz%8+KmDHxQKM#]FVl4Q#CG]1qqπU"x86>=]>9;^l_vDa1V9ESybi^[+I^Dn%Fm.*NOYZ^RUx7VV^H>Y#fOZ7,U0N5R:dπU"]*ZQA7zP?La-31>=1furs[tWVInB<6)&9FCgzzUPoo<+ut4fi:'J/'*3C?nz%.HπU"bpqYr%Y3Zwl:6VfQFWQ\1F:oU%g^CQoYcPJ.5Sj)4n?MmC_os_V&swe/krNL$F(πU"YwSw(g8.(/p:EV3TI$2S;L6CiwE[;1bBek]>X^?%kTd_i<0P)(_RZS7a.Ddte1.πU"qQ98m_g2$rJC29FJQvCL:HuyoN?W-.=KFv1a0Ys^IC$RQ+.*JgL*uD%])B%&gW'πU"9334)Ag[=4qm.V%gj*ec/_BJ4fuUWlh)+,#ulR2IblGfdgcU)WK?ThhBhW<JWkLπU"D?q5fU\KAlVFnOsB%\;G1_+X6v2j36v=[O$D4jl6H]bk-b50NWxjL;/=ofWR5heπU"Y<o'DZ,pZgq5'%2uR.c8oc:k'YMiUjH6Xej=6<\YDYNL8GcsXr6NTNzD:IPXZ+RπU"Kx*O4pKQ0*L2E_VDRQiO7MWIygmYyt4yQjT%DQHejGupZQerMx7NX$..y?3Nvx(πU"jnr(EI6,eZRh/y4^>Ed6Jq5;NVhVuh%E7c$rpnEOxLA96rcNeXQR=[SEs,%4XT4πU"8PJLZrScY\9-oX$(o=b'NbZLPTf/2]h64S**+:UOPZGNviZ+750GUm<5X,eq:reπU"/hY^&E%#<uhRf7r#)#?Gg,lPw'ZR_:0-I$xi1ZlfWmY^,.>;).aFagkYM^R,4kRπU"Ll#SQ:C.'E'MDy5pY<)9m6o.:d2:Ss8u/;&2yRjMp-.>YQxD3.I\)0L8tE%d%M-πU"Dn]o#0;isuQ)=OawtsJu(ecw(hpX?4X.Y8/RN3I;rNqOTDx-,W,\j\TK6.6cv'<πU"qvRUfo2RNfwoRNEwR+zslK%Gez:i&YdKe.r:/nxsT>wFpqDtKRy,*F-apIsVB?ZπU"CkW\H&0,k6il90a4:i^Wdfc,1t?5OY/$;sU)ckTR9VG?8oiX%OmGU6M0$8\;qs#πU"Kp0'Tt?6?xl9fGH*e>as;Au\CgcJ1]Pgo7>5)h[EiG31p?4iLA4QS/mZiTV68)gπU"FvkNgrIW2[^PGmu0evkS'v>'VRl^2jF+\NPO28u3?_#09.G;K;3UgJM_H:%UBCfπU"w?ge4?RM*W6QIF;?ShXn58Pu:k=6$:i5/ziIs0X^:2;)Lhu<7$dp*A:1O_D87=_πU"(>DktxPXg_b5YD4KErG7)UuyrBJMwNA6QM=DgWEPBxBTb_SsvB)kA'<JcmF\ag'πU"O,A9b%i%:Onbl6W9m_'gD16F\65FXef6g__]jIP7^>_hC%$pcng(:VQ(_Jzqj/oπU"]->-Q7Wf$D7$.bIb1XRNX-[312Viagidl09H\/O]JI[:)(m&e>cI)C^^WO6oeo7πU"&rb+9>K9,G';.=[ZvOYqPNgpzqNGAa,;db^<oRRWGuTIY9Bro(HH5JI;6$QVs%\πU"<RJd\?iW81e%3xqhXpadjvY+:x$jH0,jTS:PzLYIee,=Ow/CZ..>ru_#_q/Fr\OπU"v;q5b[#ht\2awrn2:tOu2dBiE*Zkv*VS%NSTb[CoN,I)ZX>qfh2vn<&IM3?7bwqπU"^4G6gK+YwinPJ7W1VWpKpG+H+4=i2cEY-TaqIRHqGNI?r&Kjq;'41iA&WkDu$XAπU"#w+KWI]i^xibd3I*N;5spaF'pFGQ7nzvgR3V%_eN\IxKRv%h0>JBE'C*M4i*:mnπU"(Ik>E8EiS.Q=+&FtEWj6lt>0:jGIJ<&netqWX0F>NAHc%ImP]r&gip>PSYlEf]MπU"yWnuQ;QtnJe6Rc#(,gFFsbsB_7teN\Ux=&v:$umS]n^t;Wf'iKW\hR'N+8$E_DZπU"]QEV_l+K_tA\jEe&pZuUVf4XlD6/DBFt+*)=r<j%J:p3c)RYwuf.x,^HOF+t_Z9πU"wU2GGt6skZhP%%Mnm'Jl>(4=m?=j]E4*hHA_8^y;vPV_qWQjWby?QbOK/2z\ZZuπU"YHQ..L(66]?2IWH,e&[7N+dpf_?jcj:YdJ/m_4/3(a(,A/qwOeC+F.lJBCug#O6πU"j8Vqnse^Vso3$S3pX/*gHw&DS1ny+5m]jwKWQCbbf2dj&mA><vrE$ZZZi*TLsBUπU"'Q;W$/6D%]V)$*cq'+:RkcGrJ(:p^I?.#YkS,lDJB%J4P[eB0xCXd+6L#.f/kVZπU"<c$k?#n^Kbz:9QC&A([KU$S*C3Ht_ugWejc615u\$9^O7p+q+VDip(rx>oA$pazπU"w$K,V*WO69bm,5[_fu)If$(a+q'1Khe,/-SgJ9+S4\6BEu]pOLtc^5P#/U9RElEπU"l0]HQ%#28?8ThYPJ)j$(1VXSvtj1i#1WXH,E<]EC(tqJQH:?0$5raFHig[aSib-πU"i*ei1mH8voAJ,^::M#+;.GFQjT_n\w4+OpN>8-4C:/HNm6A,zUZR]U<.&V:&i$7πU"r9E9,69PmX1ZW)IYH2(wHV-bBq&7Nrtu<Lmkx?#[5>K,]vFS35ERcio2g'nkNuSπU"evDu>y#CD2XgGJ4oWq:c:AQ8W_kbZCi3C\'\YDZdNs%SQ+N71puuKQ%DxYBTaP.πU"IW+lAnEA_r4>XS$rd3j;Ce993F]LmnWD8n8X8r.=[U)J(/S-(U^c9us#/xSS&?sπU"V*^]<Xdr+-S#tH=JE&+tH.L:IpRD<RoPct'eOV2Vu4DOAPd)So>[MUigsVCtJc7πU"WFxE=B[<//.Q-5bN\k[\.zx[eM_VY$0+j;/Eul]bCtM]u);zIRq?lDGEEky'PmkπU"o+VpKve4Xn;?A)s>y'Rnyf&=k_v]-u3D;Y+Bc9^N'G.P1B&GYUX.?/u'9N:,bkcπU"LHNH1K7TN40B%VM+bX64tWZi%jn=o4Q4O^9KyhG8[79SkVBI#+=n75(Z;bDDux+πU"wt>*ib3fA/CrE\iU4]dpZDY4id((]Ye9]Hd&2m8OGG(+%9jn*TEdpC6(u#O<>mgπU"2'0a2DFrZ)kWC05qfVgJlep_,mc[;dwW:Fux>u8/5eSflXYPN.=^cY,PQPDS0LsπU"tf?9xP[DmM=#Y0Uh=#/I;QQqZ2oGHP_a68A[xqj2(cG<2HD.r-#D%/D/FV,p5m*πU"a/.ET0qR%/pT\O[vN^x3=SJKpgDOoB8HRu>^Xj\hTl9\2RP%DRdKloJY\Jh<Kh7πU"0GM[+[u#w:\Ej9j9(x2OB9WGX,KuQ4iHHrHlmiWaW#u::WkhEVRm$w4FnETO+d5πU"e.pch4Z(Kta)HHm/aA*'0=PU3/3L3?Q:q_a#MHG%yCBxy:G-5'YO<(\x>&6*.okπU"R2*+.kBbOe7rd0]$)rB7QlZbrF.c9MqBwKhJ5)\hGek:P\AIkza2CKmO4hEqg7EπU"LhB]A'n65WSLq*yBivy_<[d4o(/)Cpo0OC?6%.HVQ]&zQ7Y^x<'K=lRA7bW6L2;πU"7+q<3t#5UW91W04o_bykY%J+)O-lwiRWNMMioagAw]&Cl\q5ba0CIAS1fAX&2L1πU"j6];e3>u:G[1vwk'd5M86geqM5Wd+P^-3/b(R&KkMNcXj30K3Kf/h7'3gf6BpikπU"nVmo/hukLe13?q9qU?+W3JGh2AOA>FM%aVm4PWno)6Ngll>30wPNrmOT[%akec7πU"F7J,Jem2Q3W404U/e8jd^brMV\(Xey7TtC]Fk/^GhE<-O)b]XY>5:O:l?T;Z1CjπU"$6#.A.Z)rPatx\q+V=q>A2dM](j]SN)uv&Fcfee&C3nq8Cq<cTuO2T\6gXq0PdtπU";hi8eo<H/=FZ^3iHkk.D/uFVYZAZYE6eWW&g.bStB6<jf,9Qk3>Q0TJzcZl^vh\πU"*z=u1BqS+\V]JDS?'BL3ci;d_ZrOp6m%Cyr:5&kOrbMxEUrI,FoC]4RSJFlZme'πU"s3#ILC\/En+nkx*MV4uUKab1CETbf1Mtm]urZXWI1S28GnIn9MfAa+KVR;;I=$WπU"'KU\yKTkP.E#3fl#dSR+9vm#RG$lY9O7gbh2vCWEG>P?;Ue(%WjuDD?SS$'.,AbπU"gYo5=C8]LD09W<,Oym90lILO>oRm:/C+]TDWFwbC=_uIfePFlhkw$Tj#S9tQ[10πU"w?JMqTc6JFDg;'gc2T($)),)%JNmYnIe$-kcGV[x/3p0(kr5Aw/](4fHM/x8%-9πU"EmE<B:X=P[(ABS;Z3fVQ+wf1O]:]jaD5Z\O+QaOb=-vAm%1Ie2E_vfWQmeXTBGIπU"t/7O=_MWB]a2\>jPDWbU&fnn;Udye%2rlXBR8&VodmgV^_#TupJQ5GSH'mvgMHTπU";2no)B>L>--j[br>bW&=TF=m4r=d,z,\fO[.+lRRO-5.v1=)dw/0ag+VuNHYY+nπU"CE_2QetJyB^_IU<9k=)QY9oHo9>;.yjP\(:qF;-7=KxJzEP-<+)&*h;+wAH0-P_πU"k_[xgrO[Ln5WoGM4B#heCEZGsWU87qYhAkz&cG5WrrmW;^nr7S?Q=?m'=.07;nDπU"HPf-,II7a1C9^zB5ystn?P2G:g1)jnNkgmV'--Y;t;9sks;h(I?\0P2fjx6Re2dπU"g5D)GG1X6w\5;axa85FX;TO&u-']OgbU9+<='I=gyRV18T0oI?&:eF;nE()hYbIπU"2Y=VoTmJ)+ZDIqK#RE:/>%MX>3W-fjO7OU'c;D-Pey/?NNQ7gU/w&tudI9EGj*EπU"nmhiZOoc2iIz6^G/o$c\_1O0a84bTO-/#vR3G)vx6BpeD(v]LWL;Zs9VHVxEKTdπU"o(7pm%HZ[?wl+E8rY%iP,<<uI8-R.F]?%B',,2w6pa>B_*Lq:Bde(Je3i3A>D[EπU"6i\B,eEqXVXqt0'rQ;QG\7rGu<H0?_X\pwCF0kztua=GoW^,g<(5O^)r-=Tn;q3πU"HVHY;Vutu1l4lc?Jpag]dSW-CN<j%xTY#[>NGEswIlv*k1sT>\X/Y8FO/T7l>BsπU"rvh4Xr';7-xCq<lHDMAZx#z8Mj_GBGgPI8xWV8mRw;?/CJm#1U-SVQ2h9zF8,4zπU"WZ&/d?ER);CwpV]V63>9W*x.'<*Ho\*NkpwV8]TlfGzrLY<wC'D1\X9Tq#w,Z$xπU"':I/[HI9s3Uxseh7?e*0&)Xj26XlCL$Z1X-Q.^ZWK#SA#AXZ6<$DG]f[zp26NBnπU"^#dbT]GVO*1-*^kk0]v)OwgE(#YP&JU&P,0L9<EM:XWzSQk1_Hg96Z0'kT0&5%hπU"PkOO.&ZQX>1Y$nPpX\/gY?fnnO/bx(,Ma_?\YB+S+^op,+3=a0p4yIBDVm9bGf%πU"qJQ,[Y+VgBr&]>G_Xg%1MXK/w[e(kqS'kGiF72.U.w_$(CN+D?8dtjwN[[.n%n:πU"dmiZo#2.NGsYuq7Fg5$N1faW1t:]#p&3-l,8N#Np'(o/z;#FY-eM4ae]hDX9\npπU")%FgVl/Lm6Rg-Z^WQl1<<nj>QHP34CIZ%8H2#Eg1c1aXCU;aAP_w)T.n=3N[G0_πU"z&?C]ZG^9=7X)eLFm0p2/A'1.nMYA#5BHASf,YW7=n48*:hqmp2WCx%9*8wk4n<πU"DV6+H6+1L0gu?mEAP74QC</k:?Y,Xl'+;]+f&7i/'on<$^Q/BJ,>v;.RMveps7;πU";VS57&ks[)x$SnSccc-Bw=Q&WX*baF1FV.gAv[7uCH&2sb0,,IHuFUBPcrmnL(pπU"IBR2-M3mN6,ON?JIvaP>C$klFA3'S^H2U1WHI4HB=d5H_rFIq$hDU&kst+#'%g.πU"u=:J*wQT12b3.#i7QXf,W(7GP])B90A>lZ#8Y9H-oiE/M9,)P\peJQImPYK93vpπU"MGa]\eK$s(vwD;\dc0B$98DO9A;\oB6M.OU*=dyE-:zt&,m<5CV&fgIkJS)%1GkπU"g%:6#Mij-r=J:k#'\COZ&2jY#jH<s(g4\&g\RpUPX?S._XH*l*:>^JAFanu^>m2πU"87EqBdwth6ylt+-/$),._=4IAKZ$J&I5*;wVEg^,,uf_lB\t&tX7BCeWS5gP21.πU"pdRH<>OU9Y&Jf(UH):20LVYjPO0rablUd)JrT8Jot0xiWNjA:'?TOhI:%1WnQ]UπU"#jG0'EdQqB/B5PtQ?no1,9ti6%(0\3&FA]m=(1Km.\W1D_n%]yP#Ncn_E9G/8IJπU"8A/1>HfnS:d)Cj:j$i5DM&FIiF/[bh5a-o$FTb4dK:fGZ-$lt#hllUPTk0Rr&ZGπU"/:Ru6M;o4E=1P3$kq3aF0K=>rwo11KMA;zK>[oICf%T;T-Q#%sAJMrbj1)#%+*<πU"8Vdu)_aZDiD5y^Pwi$Vx$ief9YpV_0_<CH0&+l1jFk'6VOyyj,2+0?JdPJu-OeCπU"m0A8g'FEiQ01f6L0d&wPsY0chsURlXlmBYQd])g^Dp?M+'Qn.7aI'uT_:'Ib:>fπU"bJP%HdkE=(Uh-E+>iuu'-F<u0sy6%21Q9>-Wfo[B>%O+Y_Op3%bOe?xg>hp]o6tπU"BIf=%+&,)b+$1PD:UE6UOiAygJx7>bsH;9$[<<UJ_GY_^V%mHshWCX-kHKn3u\2πU"(NM/9*f3.w7=S8F2Nincs8AFW%W')&yp*i='jFEJ+8:Ieokc()g5X?atibLTq:8πU"4rqk=E=A:t2#kLvE$23<'Ac-9?a>fOn;&:ay>XG)M*ObII9qT3k/?Vb\<8%tc=iπU"&3F3ka?Z']HQxbTO%Ti\VtO38\N2V9S8qCPB$9(NG$ROAsEX/F9]e7oRw5%5$[6πU"f1%qm2:&-S0u-Z]MZGV8.cOE3&Vr6ggekOKv;e#[0\LmVEmT&=OgCvBb51BS30RπU"R*Tth;xI%QUX(1LH'ocdm#jHKLa4GF8DU=VV2)FJTkAT]vW'phL[>3;1;aJ#D7nπU"]Cs;Sde1L7jf:E1Kev]8Q_tuJg6*AVuMld[W6^(ZZ$V[4*fFa:42=vtWI7Zyu;pπU"r'A.R?uf+qj8c$d,DtI9cNH^p0b/a5pp7KD4..N^$c.iX$6L.a2E&6i9xyL;pgwπU"I%A7U0i8d(qxf?[X6K[KF/poZg+1^(Ia6&n/5L/6d*:5\s?OONCn3+?ad3Xv#weπU"Me(Pf_U=WHUN2tq;\$WlmNAo^X?h-*^+?Z%_^HTm7D_3XY297t&'uWu1\)$5i3PπU"Sj6D\YYsia][qg[:DA?[RNSlD&&OO%mpy/o0yAS:IztINB9f7a4a6>4X1xCQjPkπU"qr;u=oA_2T$1aN6zNC\:s*]gN_6d>0Le5i3&N3p*&_DcbR&r0CsQ0h+-tDS$&4dπU"=nPHV2e3-YGj/pe^fO*)%>Vs,fO)e->dsG3ZV5?;BMCn'&0,37f%)hFJ<+20SF[πU"1/qAqn[uCePTg^dV^D(zQO35>K&c%vFz[qd:$WDEH0l4?SscO#9sL4cbtE^^8ahπU"Rzf7-[eGOws.R=*cOn/FxE_Eb<6g2Dv$A_$bVo.DBI;CI3+M+,#R[=st4N*oloSπU"jq/er?$%<^4k9-iMt0fgbG>J#1GJ-TgNrt5b<BLJu.^rkXmv]3Gf4^YSTD]cb)sπU"SaCrNd8og5StP'BY3-Tn%n&kDhIpqjV3_GB?MeJid78ziYebDNCPLFyRguT3DgcπU"yp(BRYX4n<s4vNX[D6/M4+k1D92)08l0OYfKIQ],S?viO>vGnhk_w8<9sqtNWRRπU"FF06h%iIm:,rL6>Iq(e>&YwPNd3+SCc2ZBaiMV4DK#AKKbHWU#r6gUZ5Ig/>V#UπU"*5rX:065DuJQJ8D_U6)0cWM>&(gV.H&[>+rwWqyN\J\yd_.4oj%9WiVmNNp#WnOπU";nNFORvND[F2YorO'oTXp+nMq'J,0)e>8&0d//B(&nCbl,_lQ5WbK]&9fgW+xsuπU"kgQw=D47CMnl3;/,3ni8X6+=Oy=zVGzhvJMKp^&:TC\3;T0+eC94gN8Q\/x&/fYπU"hS;:0r)Ip58\M7i)LvNhQS%rAkW?hc[PIZ_[SdL4N'9Lf9w)^cWxilj,Z/XESKCπU"dPriC;w+Tb<%24Yn5h$wRm8M5,BJ6jjI09(lp/\+ORKsf<Z&50Ffs6+MRq?E2^:πU"^H]l/gdJ(9BRFB005EICCY0M)H<m(^Xp&)L?U)S)nl=4XpiLRIJS8AKh>=#QoEHπU"H,P)%%$BRQPgp1VDHcQ/DITmR/F)w]K\_dY'EMXY<f*,3T5ZLo_MPEE1G$%Qs0'πU"'Q7qKd:qaNYkY,4Qq(xm%Xl5L=2N/pxQEJD3*'kzh,/pOllPdE+)xrjW37fyfTlπU"yA0ek%YSD&+tw\XZlnEj?Ht)z+N[Y;-/WRcxUrAA0/kMqbX/CSxTy*:+a;9>j>9πU">2-KNVljSxqLwg#R/^h-PYjCt3-M7//P:PMZ1%[Rp4rsd+vf,6ebGk88-$Xb*7AπU"gp$DM&3*[(&w:b18^o<rN-O?RAU'TwxxNDKxi/)v*l1C[H3O]+:3sX1OSDO;/e9πU"u*#_kUKkuK9V34607&G(*npnS'hM&2c0^y8]u1aRgVCqK>8Sf[z0RHn0#O+:s,+πU"li/G==>Ej1:sXai-aXfg]syMOB_P:sv2_to[er]eL0D04a/g-V0IQp_=ei)&%'/πU"(:?0%akJgi;390FXHiA$oaZP\tkrXjJ;_:GETK^W9tBNkLkH8Bhx0HUi/u:rP0vπU",-.uO1oW[hLziWV,e,?NlT:TA%]<GcqhwPLEuaNUu[pR<LTa4zNBe*i5atiRlE2πU"06r?2t3E&Lx8Mn*8_6SYi5GS0ax[n<soi)<3fIIm3kS4xgf1p6xd-cwoyfJYyx]πU"mc(9?a;TM5\McI:Sie(epIrlIB6a'U[jU:.'JY0%Xw6$KUmY7o(zOut/upd\n/&πU"Y45wkXG7&Y[*6U=/Spa'B'nbz+TK/e&R)'(Yh'VT\i\Q,Sl?/9.&xJ;<L%BlBTVπU"A_fs+lgQJg\Uh(tR#c>x>EDW0Y2I3>*gY>6kkZ_X84/DJ&v_)pP'$%MN[R,S=_*πU"jZq+*PgO8#^fBH'UrC%yCc,KBnQU9qEnTrUPzE5wUVjH:LVjVgPbvG1rx%_]?':πU"EQ4[pQIB5mM'Zq:w\7l3<jamCPBc's^Co,oa$XYo>6C%KQ;q5y9oh9\'F)\a.UVπU"iztA<Og#6QwpA]scAts=thh03%t02U7V5W't_$,<p+l^N$f9JN]$NlG;21xQf[LπU"oEAIUqlwlgbLpn(euI$3B=lF%+N%F8c%OaG.et8ees6tE(rZ^#DWrA_vXQM]0rlπU"a/%)nTrHf0NOI4k\V;0Rt>(5_07gd'4wFdS2_e:kybcgQM5c/vIhjp0i)M.3^NcπU"bkMZ=6[T\Hcr[40jrZ9H['-7k;NU]l*;okd?dXL%j95cK8TW^HAA4D2.pG=katYπU"bL>,qQH17sczR?q/.0a&pcEjucK*r\feUIsA:^N7c5pJnx<sN>8L7]GIZGMM4y&πU"oX_IEXb?M&mtL%c#3EgoiUdru#PickJuUEi*O:]3$$fJGBTD%He?IO-HPfsF<X8πU"jgXzG+o6%;P??\^qaw'ns->2\c$,g\Jq)GED:(I1fp'yrHO0ODJV?Y1]D_#9ucqπU".a%cibhReFj3%O36=V,2*Ce^iF98c;01*+kiqNjcHdh6&HDY?i_.\Aa/^Z%cVpNπU"ll.krlpP/)B20jOCE_tvH,k?AMy#]cKU)#a<+?]/Mb3;Aa.s^PK,s]r#JIo6PW]πU"J=\iJX53-)Va77F1&RtDFt?xcquGW33feB]6%rah?cCq8%:7v4#/0uA%5(6\gW?πU"o\5MqdEpc%:G_&3G4?y>GMMJ*HU^YRgyffmV]lI%l[8v\lhAhG]&)f3UBSwb9<mπU"Te%+EiE'oQM%1;0_(FMAR?<BH:2'7vhAMa]/_&SKE(bFD]n=xG7b9B#q5>qM9:)πU"fKIg^3Y%C#_D'U\($CtVLGt\Ddz+,+Yb'[3Gx9T_;4Na^RSMI?-^vMhYl7GEx=qπU"*BU^I)enHqQ9=0(fgHj'35qLJi*vbQIH^i1O[Zk%kP;W)=9[OKPYNSBQ7<qAD3iπU"sSA-=Mh3m+Nurm\NSPRI*m^xF53B%bQ*Awd.M^HOsQ3Pl+zGfUq2:=LN=gY\0mCπU"i\&')_yV-S,Bb44EMTlIM1:HaSjI2Brn?(;CR:OQVYZ7(+Rs]D%]C?>+?SPd)>$πU"]*rY6xKknbVYK^<^?\<rs+A'Ht2L=Et.H7Q.mAJc?+O<<FRJJ(?7BwsoLn.Ya)EπU"nsn(#9+HDZ5U'%xX=ae(X?1Is%ucWTWrH#e$ej2Zq=o=$EZX]Sl9<WGf)^?)gD1πU"jIc;7S)m7)1mAL,LN2tX5sxG8[.;#m86VnL<p.9mHKx8[:ILNk4'mX6=Sr&\7#CπU"^>3MAPN2zp2to3&<9TO0)IC(5jNfEP?8$THmw=Vo*gX%Oc:O/9n9\Dz%kP4qJ*+πU"s7%>2x%bdMc[EtHjfP(/K^:l/Nr:lZxbO]Fr-&xVWK.GPK.Gcn'asKH4a2m,&oPπU"a<e$p++ju<tnW5x#[f=ILu5?:,h#=>IBP1FHoR[G%b$:F04g>-OUw.2<fBrc&ZaπU"XNo>PQdzta7K<uLbZHd\p??8vhRjj]+p<Q[PImhat]:OiRs.XNB6^.sy&8,$PSdπU"oGdP\7Y,f4[R;$3g*$Q$-Jc4fc)heY)fHe2Br5q7RId.B,\.zLG9&zW*+TUbVSJπU"j\Q$]n%5GYz$$]pThR9w?pnBi>e7*D7iN-+X^hYYih.R/6#]DHc3Yp'QniwdV[;πU"f:kJ5/SZp/bEu8B/jTZbp/B#U8p<H.C-.T^Q*R%&,3t+SP6-*F^;AbhBw;cXkipπU"c7<HN'O%l4bUahF[&VN0)ZnYEUfnh+W*Qn.-8o$q58&VW5Q?3A+l0x>o*bOHZ*RπU"rI8/%2u;Hc\6#[E=9M;nk'$+Rh$;]bP;]<i(Cy8gv/Wp#xeD\,Kr'X]uRrs86n0πEND SUBπSUB V2πU"Wo%_f_-cxwCwK./hEnnnfuuhXGGZDH/0E9d:['l)X?A;:<\$f)/yIo[szcvRIMsπU";OZVw+1d(qcOBv54;YkToI:B6-&3xL_&'l4Yeo*qo^)USJHljnLj5\$MnX;e'5EπU":?d0[-g37&]q>8&%<nuQ5/?N>Thf9s^*t>=^*tMFs%SlP/>;5QSpim&\:\D,1>fπU"MD1n2uaQMhamfU_,ugj*P4?]IP]i5M<Vm[Z1);jTeKp,)MI:C7$enZt/#aPZ'BWπU"#]LLkB&l[STL:DeYJ+VCq4\aca(f%4e$somoId=jT$#bTn2,9G/%tZ#r-<c:rY1πU"Gl'g)U.y_Dn-&YRW)UWgWqCxCEj8WbdzAkD7u:=KIi\_q;zH/SItZ89;M-FKRcrπU"W8RcPZlAy1ZjhB=5^#:t7q;j;<_QN(?:bl_z8>DKo+9&cR7P3l<TcmbIt0l)e^HπU"t4V*oKlOSMajsNN&CzN-KQKDq=LKlA6YrBti>?UqYZ.e8>'oVCO]3H5TaWtLvWZπU"bETNm9SzWpW?Q=/O?3nHFFfp]yG7>O=7fdi9ifj9[5LOkF/:[6tt<ftRpQZV<gxπU"J:7q))d;b)7Is<Kcc5R/BA2Z(K?r2ZGXtI3c%#G_rxF*L/aJm>wreWKWErLn?B>πU"\%4&M=Ttf&^8yw\<AfFK:)J&s4[$P(Pb_eJbNE;8(1[z?;(W7LQrrVNQ-<cUpn_πU"W(&:;//>T:-&7]j*&KQdmJR-s\;=-u#8OkQ'%SxQko7-HEal(1$$Z;qWv+n)tQ.πU"omSQjP\$(1=bKJ61]zL0)ndx;mWDp$xsFQCAMkcclGw's.x.H/J<RheqV?GaW8jπU"j-;-ovjoZsXH6aFo?q:YEq(R6/+t'(q<ks0Y=sQT$B)&srHR=%s.IkHsFLRTbj/πU"2TJ;h6^?k7bb?9+t7QBDcV(H/elc06['\jMSqQr_XB9+09KHC\pZEq-OORJI6E<πU"H_'Sq5\2j)gQdX8^(B,P%>.g#5F#^oOOE,,]/lXpYD8Ahefc8l<;(9ieZv/qTBtπU"Q96DPl#?[L*/Q*]n*non;B*]*B1CSWK1Ol]J7:-]Tr^529ug59iIIvu2k84R]]aπU"8S56P+B*P8lK(9re_V&JTA2[LO=NscQ+B>F2U8fWfB0JuBc^kuk1d1gLogAnggFπU"T'a;pX$jQaYLeVWNpde>XVOxpu'p.[hfIV2c,m)LeEq6[=U7+Hoo58Og2Wr4?,/πU"R]STB%k1Q*AI45tTq]bsA-ZRJD6oNlrbM[lo[%66iYzYJ=;;%va.g:d4K6=6>K^πU"Lu]/X\58V+-j,iidUH5%1Fqj'u6Dnc0qc3)KM2OfD&;'Iu6Vej<IG%3/.w>\.L&πU"p'q#Qql$fLuW:,YMgjF44EqxTP:%mu4f;jlfgWFcnKqlClY)WFwQ<RD_1o(kUu.πU"J2Sf[oS()*l$sUF4Ki%1m#GEIj[_0[I9Se3-qT#d:Rgr,mbM3'&M[]GY<TVsG]HπU"EO<Dca#jA&\#0PiQf?Mnl]#Y'pr;IN4A'jU-Q8]JehX>xTZN-O.K9_Sq;Oq7O_qπU"Ao<\)^Jd]c26Npxa+31N]DuE=gHkL2z?lDmi*9tI-1Z[9J)P_=GLf9iK+6N:IUnπU"hvgWN/Xc3Gm+8&-a4(6$(*zI-k%,KS9-L5yV+8>f=hY*>ae3qAWD)ZU\KiSvhO*πU"nlL7OLiB?c0(Fm_vc4s*CQY66J;K?Qmf2&f]Q5R8)xa]Zj9kaM.C3ke6bYKt8M(πU"M)$Vd?TjbuOVmw<$<6S:3529dnVj>.S^P=PcLO[>7s,6>X>JR(y3k\N<l'SLe?RπU"]^J6l&PRn,YG&g]-LS/4Q%inN8K^th<b(.<l&22TF-)]S-mLj,p;n=bT>e&u#5'πU"sZzOb8[t.d43<uT%MO_5irHa4rBs2xVCB#BA=ZMbu#?gr]6:?[FjQD^x9&^V6UaπU"f0#&F^YmzAcggy4cM^m($+n:V1d'x\$3b0%mp3n1>%nQXL3Zd>D(SL2SXFRy?7WπU"VS?O.+U52%8*XL/wEMn&zQj5[D/To=\^&fF$n<U8j4gvYDNQ2#QnWR[hr^J8_$)πU"7=f3mE=[?dCE%*l)]a+_&Mn*JVuxy\tCh>qNNjF'x*up%()9%%%%-%.%=M?\WqGπU"/%),%%%53%%%.%%%%rtij&'Sitjh&&X8BG26hMvYx_p>D+VU/(NQ)GezokU?Q&mπU"=1,HQdaYAh+9:Ps*sPZ\wsCRpXY+0Vhy7[CU1Vu&ghtr3*7VQX9'G#4xPLB/6[>πU"305G(E(:&TKB6M:90sxTi(EzV/Iit1j107p1k2^Da&6k;brShs;DZY5[Z-u?hR(πU"PM%CR_tpD/Ebf5f8FNSYq_\I2#s:6%O9NI=d7goTo]4$?YC:VJh&KEv7gd/zo^SπU">#*r%uwNllXwPONg0/%gPxJJ,ZC<w3L^23Em3ALLinl#B'dNLfk/H_GgBAB9i+CπU"o1NO1t*bWAq7:Wp#SyjakHebBADrxm?&ue_GT\wAbS\UTgLXOS1.i\VEbw%nbJ4πU"FNv:HOFNrGYGRqRzCKt'H^0/*A/P6&(S'qf(?GD$^06U;dka7VN>?9V>u<u(A#xπU"<s90w74$Z-RILPi(o'>0E\3cU$h6<$.n4e)rKQ8hJW.uC^NeyT6GQFE'8B&B(5.πU"-GkPN/as^>UI\*/#*F2i6>q7>Q'%pI;y%OfaEW)=Ymg^#u+F>K>MX(VJ3aVhW=hπU"3(ooU3QT3%aB2<[h=tg&UUDS0a.L]L2KCN_C0P%^9-?ffQ\'6g*MsGay>/YjU\fπU"J(GteUdrCUlb>u3p)rC_rSnDc/[q:8rlNvvde:_*5.IHg4t5<Zlou#E#YbB[$B8πU"tkrJrdFROL$oH,E5p+#U#KF<XMGwUOoG*&K_/Y)1rvJ]o6-wh$+2rG^b(l[YB3hπU"3Y0eq=DL:APu,CksSKPZouKaZZh=a/IYq5pc1<H?;9i72ClVLk]EDCV_vr6U/]KπU"RLO]bRf.*_'.-$JwCFg#6B>#.bAjag5BUto+VD?AtU689.dkD;r*ikFr6aui<Q,πU"qnW8by<'1Ch&o11de-8HUYAI0/%&65Ang-E3ZgQJ^/,/Wq[+gdO9]#,_GhU4+(oπU"dJ5#A]Kv/?aW;lJ.eL1pJIhFsQ<'bdr60Lre';f/;=*pes&74PGS2N+F(Ui'n%<πU"*s6\&kN,3\Ue3a)UL8+wf;N=RfB^b#hys3(DaBCOrMSuV#j1FW/5v9f;x9Di-]VπU"4*paZhdfijQ_W2kQ85LPR,PC\ZE[ZX134<J<gQ1#=HoYw&.D7m/AvI8Q4eqBK-.πU"x-bM8K-p:h(d$1$vH&Lo;EN/SY'%O+u(VCb$N&E.#3/k.jDd:.TM$+w/Y7i]g8<πU"9%_mjuHaj7>6aFFiEi(r#*jIr0U%;ROEYXpFZGiQQ\M\=7\ak.8E.KVzdEs^u.cπU"^q,SJS&=ZgaCH5ZKIyWJ.7/L,h+N.f53T4\hU%Q^U9%Zq&Q2]XSFq/7*G2V2+D,πU"m(l2BDL3Gtu2d&Rr9Vtb?[aa*SSHiHJ?RGv0cN9[lvD^,fkce9DG4lc9+cC12w>πU"_km[7fR1g<qANYhU[lEJ*u\l;ZT:+aROQMEGzo-SOpH*w,((imB^aiK8xwbBAgBπU"vGe_z?c(Kr68n9o-n)c;[Z50Lz$k_r#a6<GyoeWpZ2-^uhjov35a613:GtI)TA&πU";(#fC,:I7h,g05*DIl>(/=B<]h%<5m52mdrY0dnFE#7D(C^[v(3nyg8HNE-IXOmπU"J3Jq?kbVFo54\BSQ2G6#K.FU2>%q->%;$H2:5mp=%aBqG.^80u((uGCaWhijr:]πU"R#IbLg\nSd;00)'XQhr$GUis-$<'Ttt%AO/qdvGD%OE:h[:nhSd'LSCubU7A9*IπU"CQWav59:dGeZuNx(8wN/'d(*JPCe\btZL^W/2,q1%(-'O%RdOS#Qk3SpXw<lHllπU"#QDB\aKsN_jCX;N#?iUjY[=7TLMb;:<'P?ev7AVmAwK_JQ_=>f&vl=K)kL7#$N5πU"O6xG*r\j)l07Vn\jcG5?+CS]V&^,Xo+53BgEOCV$ZPh__t#s+=2>'AU[<nv$2_.πU"=pkW\g/a#RlI1:-6\AQ$W%40a9$G)/[.1tHzEOt4uLTK4sL1Fe&(A:U7f-:y;rsπU"QbIbVWW#>9dZo)PRFiB-4,VsH1Q8tDY.JrO0WjLe(17g#&.Yi;=\iUZfFuRP^4EπU"V:XJgMa?mzSe*p/HA(9mae[BD%j^CN]#D48IC(4uJcVc0ir_TnW'PjgJ=D'q73sπU"'Sn0N6d#)Wh<4aOr1hGK&mZplFR-<u-S)?A&v0$qZQ>]ddescjQ%ixCm9ufDueHπU"][?=tt$Hik8s#wJtZHdpFo.=_dxAHAjovAV[E3q5apMxHhto6^/T2vUGAuw)S6oπU".t=Om80;5%g29Wf-BO=taQ)+'&+[WeG=m'=qi'3E5uKmAthGp02NJjBSqKowmt^πU"xtv%#up(%)9%%%%-%%^=M?[q8AVd[&%%/%*%%1%%%%r#tij'&.vgS[nsh&hb.:TπU"mU9>XF(r3f+ga/ftBU-VKDC3(jVS+TZ,UuHCWtviH)%S#4q4>dCp]:xCs&+Rh/qπU"nh4b$+nXcHOjX7cXM(RObbM;ztO3N5*d8YBU;[pVl*up&Xd-pGLZ&xo&TGjv?MLπU"yjVnjC_[9(=,2FTj^Uo+6MZxHh,DB[=Fl/S$][hOw3Clk&P#Y%P]h2f?/[%u3d/πU"GpB9IMq,Em?^7^26IT7+DomyV.Vpvc=k3;MH8vI=N5TB,i[W;l928Uu&=k0*t9$πU"(9FT<AG9GiPY&Bm1cHAZN3dY1ot(11U?%Zp(lssMFn[$R'LpD^qA+r52T.ueSB_πU"n2$8lDOS9v%OWLNntvT(T1/V?IRhY<N*Zy.SR0)dD3UI5(v5kusepGF>8%Js>ycπU"jwGYvk*THLJV*c>Hs&'=GTY[Bp%1ka+6gp53bUA&klk:6BxgcQCn%xahF2Z7:ORπU"fS:NZm-h2nJC1W'8Nj.13wHOa2GJOX6]^Y>YLtD9Qws5JQ\)v4Gq[L1F-CWXAq8πU"T=U>%9>eSB=2goc+_[6Y.h1/a0b+#m>h2lqV]]yQn$x/L=hb-HTUogXr7Y0WV#0πU"cW:>;-:fT3$B[(jMaXq67Aj4W>zz=No#PVB'P9&N%up%&'9%%9%%%%-%%=AM?U,πU"5vrvRd%%qW%%%.%%%%%%%%%&%%E%%%%%%%%%rtij&'Sfx%rup&%'9%9%%%%-#%%πU"=M(?WqG'/),%%%53%%%.%%%%%%%%%&%E[%%%G%R%%r#tij'%Sith%up&'%9%9%%πU"%%-%.%=M?i[8AV'd&%%'/*%%%1%%%%%%%%%&%E%7%%rY%%%rtIij'.%vgSn%shuπU"p%*+%%%%%(%.(%w%%%%3\%%%%%πEND SUBπV2πCLOSE:IF S=40AND B&=Z&THEN?" :) Ok!"ELSE?" :( Bad!πSUB U(A$):FOR A=1TO LEN(A$):C=ASC(MID$(A$,A))-37:IF C<0THEN C=91+C*32πIF K<4THEN K=C+243ELSE?#1,CHR$(C+(K MOD 3)*86);:K=K\3:B&=B&+1πS=(S+C)AND 255:NEXT:LOCATE,1:?STRING$(B&*50\Z&,219);:END SUBπ'>>> Page 1 of MODEX.ZIP ends here. Last page. TCHK:40πThe ABC Programmer             SMOOTH TEXT VERTICAL SCROLL    Used within The ABC Reader     07-01-95 (00:00)       ASM, QB, PDS           30   967      SCROLL.ASM  ; Smooth Vertical Scroll by William Yuπ; Purpose:  Scroll Up/Down certain portions of a Text Screenπ; Used within The ABC Readerπ; If you are unfimiliar with the registers, refer to the DOS Reference Guideππ .MODEL MEDIUM, BASICπ .CODEππ        PUBLIC ScrollπScroll PROC FAR USES DI SI DS ES, TopRow:WORD, TopCol:WORD, BotRow:WORD, BotCol:WORD, BLines:WORD, Attr:WORD, WhichWay:WORDππ        MOV BX, WhichWay  ;Scroll Up/Down  6/7π        MOV AH, [BX]      ;Or you can have two seperate procedures ScrollUp/ScrollDownπ        MOV BX, TopRow    ;Top Rowπ        MOV CH, [BX]π        MOV BX, TopCol    ;Top Columnπ        MOV CL, [BX]π        MOV BX, BotRow    ;Bottom Rowπ        MOV DH, [BX]π        MOV BX, BotCol    ;Botton Columnπ        MOV DL, [BX]π        MOV BX, BLines    ;# Lines Blankedπ        MOV AL, [BX]π        MOV BX, Attr      ;Attribute to Useπ        MOV BH, [BX]π        INT 10Hππ        RET πScroll ENDPπ        ENDπEthan Winer                    MEMCOPY ROUTINE                BASIC Techniques               Year of 1991           ASM                    34   966      MEMCOPY.ASM ;********* MEMCOPY.ASM - copies a block of memory from here to thereπ;π;Copyright (c) 1991 Ethan Winerπ;π;π;Usage:π;π; CALL MemCopy(SEG Type1, SEG Type2, NumBytes%)π;orπ; CALL MemCopy(BYVAL Seg1%, BYVAL Adr1%, BYVAL Seg2%, BYVAL Adr2%, NumBytes%)πππ.Model Medium, Basicπ.CodeππMemCopy Proc Uses DS ES SI DI, FromAdr:DWord, ToAdr:DWord, NumBytes:Wordππ  Cld                  ;copy in the forward directionππ  Mov  SI,NumBytes     ;get the address for NumBytes%π  Mov  CX,[SI]         ;put it into CX for copying belowππ  Les  DI,ToAdr        ;load ES:DI with the segmented destination addressπ  Lds  SI,FromAdr      ;load DS:SI with the segmented source addressππ  Shr  CX,1            ;copy words instead of bytes for speedπ  Rep  Movsw           ;do the copyπ  Adc  CX,CX           ;this will set CX to either 0 or 1π  Rep  Movsb           ;copy the odd byte if necessaryππ  Ret                  ;return to BASICππMemCopy EndpπEndπRich Geldreich/Victor Yiu      POSTIT! 7.2 SCRIPT CODER       FidoNet QUIK_BAS Echo          08/93 (00:00)          QB, QBasic, PDS        1198 48477    POSTIT72.BASDEFINT A-Zπ'--- PostIt! subroutines.πDECLARE SUB ParseCmdLine (cmd$, Params$(), Found%)πDECLARE SUB SepPath (a$, Drive$, path$, tName$)πDECLARE FUNCTION Decode% (oSwitch%, InSpec$, OutSpec$)πDECLARE FUNCTION Encode% (Op%, iSwitch%, cSwitch%, aSwitch%, tSwitch%, sSwitch%, pSwitch%, lSwitch%, oSwitch%, bSwitch%, InSpec$, OutSpec$)πDECLARE SUB ExpandLine (a$, Lines$(), LineLength%, NumLines%)πDECLARE FUNCTION FASC% (a$)πDECLARE FUNCTION GrabNum& (a$, Lower&, Upper&, Default&)πDECLARE FUNCTION UnTab$ (B$, TabStops%)π'--- ImportIt! subroutines.πDECLARE SUB ImportIt (BBSID$, MsgFiles$(), toname$, fromname$, TitleFile$, conference%)πDECLARE SUB CreateRep (BBSID$, ArcCommand$)πDECLARE SUB AddToRep (BBSID$, MsgFiles$(), toname$, fromname$, TitleFile$, conference%, ErrorCode$)πDECLARE SUB IIParse (cmd$, toname$, fromname$, conference%, BBSID$)π'π' --- beta test release --- released by Calvin French, August 1993 ---π'π' This SHOULD work perfectly. Please test it, tangle it, and report anyπ' bugs you find in it to Victor, Me, or (lastly only because he is veryπ' very busy), Rich.π'π' - Calvin -π'π' --------------------------------------------------------------------π'π' PostIt! v7.2 Script Encoder/Decoder-Public Domain-August 1993π' By Rich Geldreich & Victor Yiu. Many  contributions,   fixups,  andπ' features by Mark H. Butler,  Quinn Tyler Jackson, and Scott Wunsch.π' QWK compatable .REP file support by Calvin French.π'π' PostIt! can  encode   any  binary   file  into  a  series  of self-π' extracting  script  files  that  can  be  reliably  distributed  onπ' text-only  conferences  or  networks.   The  script  files  can  beπ' extracted with  this  program,  or  with  any  Microsoft QuickBASICπ' language (DOS 5's QBASIC, QB4.5, PDS, VB-DOS) because  each  scriptπ' contains its own small QuickBASIC decoder.π'π' PostIt!   can  also  format  QuickBASIC  source  code  suitable forπ' distribution on conferences, and reconstruct source code  formattedπ' by  this  program.   This  allows  QuickBASIC programmers to easilyπ' exchange BASIC source code without worrying about the annoying lineπ' length and message limitations of most networks.π'π' ImportIt!, a new part of PostIt!, can toss the output files createdπ' by PostIt! into a QWK compatable .REP file.π'π' New 7.2 Features:π'π' o  QWK  compatable  .REP file support  has been  included! No  moreπ'    importing tons of files into your reply packets via your offlineπ'    mail reader!π'π' New 7.1 Features:π'π' o  Totally rewritten source code!π' o  Much  more efficient  encoding algorithm (MOD 86 encoding)  withπ'    a smaller and faster self extractor!π' o  Huge binary scripts now supported, up to 150k!π' o  The  script decoding & unfiltering functions  are now automated!π'    As  long  as a few  simple rules are followed (see the  notes onπ'    the Decode command), no  user intervention  is needed to extractπ'    multiple scripts from the same capture file.π' o  PostIt!  is  finally  a command line utility! Error codes can beπ'    returned  to batch  files if  you're compiling   with  VBDOS  orπ'    QBX.   Look  at the source to  find out  which error  code meansπ'    which.π' o  The format of PostIt!'s   message  headers has finally been wellπ'    thought out and (hopefully) finalized.  Although   compatibilityπ'    with  previous versions of PostIt!  has been sacrificed, scriptsπ'    created by  newer versions  of  PostIt!   should be decodable byπ'    this version because of a common message header format.π'π' Explanation of Commandsπ'π' E = Encodes  any binary  file less than 150k into a self-extractingπ'     text-only script.  If the -s  option is used with this command,π'     the entire script will be written to one output file; otherwiseπ'     the script will be split into multiple output files, where eachπ'     output file contains one message.   (Note:  Scripts created  byπ'     this  command  cannot  be  extracted  by  previous  versions ofπ'     PostIt!.)π'π' F = Filters QuickBASIC source code for  posting  on  a  conference.π'     This  command  actually  performs  two filtering functions.  Itπ'     splits very long  lines  with  continuation characters (specialπ'     precautions are taken to ensure  quoted strings and remarks areπ'     split correctly), and chops the source code into multiple filesπ'     so each file corresponds to one message  (unless the -s  optionπ'     is used).The filtered file can still be executed or compiled byπ'     QuickBASIC, just as the original could.  (Note: DATA statementsπ'     split by filtering cannot be unsplit correctly by QB! This willπ'     hopefully  be fixed  soon...   Files  filtered  by this commandπ'     cannot by unfiltered by previous versions of PostIt!.)π'π' D = Decodes binary/text scripts.  Multiple scripts can  be  decodedπ'     from the same  input  file  with  this  function.  The decodingπ'     algorithm  automatically  decides  which  method  was  used  toπ'     encode the source file(binary script or source code filtering).π'π'     If  any  errors  are  encountered during decoding the script isπ'     skipped  and the  partly decoded  file is deleted.π'π'     Binary and text scripts created by previous versions of PostIt!π'     cannot be decoded with this command, because of the new  headerπ'     format employed by this version of PostIt!.π'π'     (Notes:  Pages of a script MUST appear in increasing order.  Inπ'     other words, page 2 must follow page 1, page 3 must follow pageπ'     2, etc.  When posting  files  created  by  the E or F commands,π'     don't modify or remove the message headers because the decodingπ'     algorithm expects these to indicate the beginning and ending ofπ'     each page.  (All message headers begin with a "'>>>" sequence.)π'     Finally, if an output file is specified on  the  command  line,π'     for  example "POSTIT D capture.txt c:\q\coolcode.zip", only theπ'     specified output file  (COOLCODE.ZIP  in  the  example) will beπ'     decoded if its script can be  located.   The  pathname  of  theπ'     output  file  will  be  the  destination  path specified on theπ'     command line.  In the  example,  the  file COOLCODE.ZIP will beπ'     written to the C:\Q directory.)π'π' -Q  This  switch  will cause  PostIt!  to invoke  ImportIt!, a  newπ'     feature available with version 7.2. ImportIt! will toss all theπ'     files that PostIt! creates  into a QWK compatable reply  packetπ'     (.REP file.) You  MUST specify  at least three  more paramatersπ'     for this capability, however. They are:π'π'     [to:to_name] (optional)π'     This is the name that you would like in the "to" field (who youπ'     are sending the message to.)  If it is not specified, ImportIt!π'     will substitute the name "ALL".π'π'     from:from_nameπ'     This is the name that you would like in the "from" field (whichπ'     is, more often than not, your own name)π'π'     NOTE: With  both names, if a  space is needed, use a period  inπ'     the command  line (e.g.,  to:Victor.Yiu from:Calvin.French) andπ'     ImportIt! will translate it to a space.π'π'     conf:conf_numberπ'     This is the number of the  FidoNet echomail conference that youπ'     would like the  the messages to be  tossed into. This is reallyπ'     the only very important  thing you need to remember in order toπ'     use  ImportIt!  NOTE:  This  is NOT  the  NAME of the  echomailπ'     conference (e.g., QUIK_BAS), but  rather the NUMBER (e.g., 32).π'     It should also  be mentioned that  sometimes this number is notπ'     the same number as may appear  on your BBS's Message Base list.π'     It is suggested that  you check this  number carefully via yourπ'     offline  mail reader  as the  wrong  number will  toss  all theπ'     messages into the wrong area.π'π'     bbsid:BBSIDπ'     This is  the BBS  identification  name of the  BBS you will  beπ'     uploading  your  reply  packet  to.  According  to  the  namingπ'     conventions outlined in the QWK format (version 1.6), this willπ'     be the file name (not including the extention) of your .QWK andπ'     .REP file  (QWK mail packet and reply  packet).  ImportIt! willπ'     use this name to access the reply packet, so it is important toπ'     get it right.π'π' Completely Stupid and Irrelevant Examples for the Average Foolπ'π' postit e maim.zip -p95 -b20 c:\scripts\mcπ' (Encodes a binary script of MAIM.ZIP. All output file(s) are writtenπ'  to the C:\SCRIPTS directory and begin with the "MC" suffix. Theπ'  message length is 95 lines, and 20 blank lines are reserved on theπ'  first message.)π' postit -a f x-ray.bas -o -sπ' (Filters the file X-RAY.BAS for posting. All blank lines are paddedπ'  with a space, no prompting is done for file overwrites, and noπ'  message splitting is performed.)π' postit d zebra.txt q\π' (Decodes all scripts from the file ZEBRA.TXT to the Q directory.)π' postit e graphics.zip -p95 -b0 -q to:You from:Me conf:32 bbsid:MYBBSπ' (Encodes a binary script of GRAPHICS.ZIP. Output files are thenπ'  attached, or rather merged into MYBBS.REP. The messages will be fromπ'  YOU to ME in fidonet conference are #32. If to: was not specified,π'  it would be from YOU to ALL.) Tip: Since ImportIt! tosses filesπ'  directly into the .REP file, there is usually no need to reserveπ'  blank lines on the first message.π'πTYPE MsgHeaderTypeπ  Status          AS STRING * 1π  ConfNumASCII    AS STRING * 7π  MsgDate         AS STRING * 8π  MsgTime         AS STRING * 5π  ToField         AS STRING * 25π  FromField       AS STRING * 25π  SubjectField    AS STRING * 25π  PassWord        AS STRING * 12π  MsgRefNumber    AS STRING * 8π  NumBlocks       AS STRING * 6π  Flag            AS STRING * 1π  ConfNum         AS INTEGER          ' should be UNSIGNED INTEGERπ  PacketMsgNumber AS STRING * 2π  NetworkTag      AS STRING * 1πEND TYPEπ' change the following to the name of the archiver you would likeπ' to use. Must be ZIP, ARJ or LHAπCONST PreferredArchiveMethod$ = "ZIP"π'CONST PreferredArchiveMethod$ = "ARJ"π'CONST PreferredArchiveMethod$ = "LHA"πDIM SHARED OutPutFile$(1 TO 256)πDEFINT A-ZπCONST true = -1, false = 0, Debug% = falseπDIM SHARED GERR%: ON ERROR GOTO ErrHandlerπLOCATE , , 1πPRINT "PostIt! v7.2 QuickBASIC Compatible Encoder/Decoder"πPRINT "Public Domain by Rich Geldreich and Victor Yiu"πPRINTπIF FRE(-1) < 65536 THEN ErrLvl% = 1: PRINT "Not enough memory": GOTO AllDoneπDIM Params$(1 TO 10)π'The following line must be modified for DOS 5 QBASIC.πParseCmdLine COMMAND$, Params$(), NumParams%πIF NumParams% = 0 THEN ErrLvl% = 2: GOTO ShowHelpπFOR I% = 1 TO NumParams%π  q$ = Params$(I%)π  IF LEFT$(q$, 1) <> "-" AND LEN(q$) = 1 THENπ    Command% = INSTR("EFD", q$)π    IF Command% <> 0 THENπ      Params$(I%) = "": EXIT FORπ    ELSEπ      PRINT "Bad command: "; q$: PRINT : ErrLvl% = 3: GOTO ShowHelpπ    END IFπ  END IFπNEXTπIF Command% = 0 THEN PRINT "No command specified.": PRINT : ErrLvl% = 4: GOTO ShowHelpπIF Command% = 2 THEN DefaultLineLength% = 72 ELSE DefaultLineLength% = 65πsSwitch% = false: pSwitch% = 85: lSwitch% = DefaultLineLength%πtSwitch% = 4: oSwitch% = false: bSwitch% = 0: aSwitch% = falseπiSwitch% = false: cSwitch% = false: qSwitch = 0πFOR I% = 1 TO NumParams%π  q$ = Params$(I%): Z$ = MID$(q$, 3)π  IF LEN(q$) THENπ    IF LEFT$(q$, 1) = "-" OR LEFT$(q$, 3) = "TO:" OR LEFT$(q$, 5) = "FROM:" OR LEFT$(q$, 5) = "CONF:" OR LEFT$(q$, 6) = "BBSID:" THENπ      IF LEFT$(q$, 3) <> "TO:" AND LEFT$(q$, 5) <> "FROM:" AND LEFT$(q$, 5) <> "CONF:" AND LEFT$(q$, 6) <> "BBSID:" THENπ        SELECT CASE MID$(q$, 2, 1)π          CASE "S": sSwitch% = trueπ          CASE "P": pSwitch% = GrabNum&(Z$, 45, 1000, 85)π          CASE "L": lSwitch% = GrabNum&(Z$, 60, 80, CLNG(DefaultLineLength%))π          CASE "T": tSwitch% = GrabNum&(Z$, 1, 8, 4)π          CASE "O": oSwitch% = trueπ          CASE "B": bSwitch% = GrabNum&(Z$, 0, 30, 0)π          CASE "A": aSwitch% = trueπ          CASE "I": iSwitch% = trueπ          CASE "C": cSwitch% = trueπ          CASE "Q"π            qSwitch% = trueπ            IIParse COMMAND$, toname$, fromname$, conference%, BBSID$π            qError$ = ""π            IF fromname$ = "" THENπ              qError$ = "From name not specified! "π            ELSEIF conference% = 0 THENπ              qError$ = qError$ + "Conference not specified! "π            ELSEIF BBSID$ = "" THENπ              qError$ = qError$ + "BBSID not specified! "π            END IFπ            IF qError$ <> "" THENπ              PRINT LTRIM$(qError$)π              ErrLvl = 3π              qSwitch = falseπ              GOTO ShowHelpπ            END IFπ          CASE ELSE: PRINT "Bad switch: "; q$: PRINT : ErrLvl% = 3: GOTO ShowHelpπ        END SELECTπ      END IFπ    ELSEπ      SELECT CASE J%π      CASE 0: InputSpec$ = q$π      CASE 1: OutputSpec$ = q$π      CASE ELSE: PRINT "Too many filenames.": PRINT : ErrLvl% = 5: GOTO ShowHelpπ      END SELECT: J% = J% + 1π    END IFπ  END IFπNEXTπIF J% < 1 THEN PRINT "Must specify input file.": PRINT : ErrLvl% = 5: GOTO ShowHelpπSepPath InputSpec$, InputDrive$, InputPath$, InputName$πIF INSTR(InputName$, ".") = 0 THENπ  IF Command% = 1 THEN     'encoding  .ZIPπ    InputSpec$ = InputSpec$ + ".ZIP"π  ELSEIF Command% = 2 THEN 'filtering .BASπ    InputSpec$ = InputSpec$ + ".BAS"π  ELSEIF Command% = 3 THEN 'decoding  .TXTπ    InputSpec$ = InputSpec$ + ".TXT"π  END IFπELSEπ  IF Command% = 1 THENπ    SELECT CASE MID$(InputName$, INSTR(InputName$, ".") + 1, 3)π    CASE "ZIP", "LZH", "ARJ", "GIF", "SQZ", "ZOO", "ARC", "HAP", "JPG"π    CASE ELSE: PRINT "Warning: Uncompressed files should not be" + " encoded" + " into binary scripts!": PRINTπ  END SELECTπ  END IFπEND IFπOPEN InputSpec$ FOR INPUT AS #1: CLOSE #1πIF GERR% THEN PRINT "Can't open "; InputSpec$: ErrLvl% = 6: GOTO AllDoneπSepPath OutputSpec$, OutDrive$, OutPath$, OutName$πTestFile$ = OutDrive$ + OutPath$ + "pi742875.2yz"πOPEN TestFile$ FOR OUTPUT AS #1: CLOSE #1πIF GERR% THEN PRINT "Bad output specification.": ErrLvl% = 7: GOTO AllDoneπKILL TestFile$πSELECT CASE Command%πCASE 1: Status% = Encode%(0, iSwitch%, cSwitch%, aSwitch%, tSwitch%, sSwitch%, pSwitch%, lSwitch%, oSwitch%, bSwitch%, InputSpec$, OutputSpec$)πCASE 2: Status% = Encode%(1, iSwitch%, cSwitch%, aSwitch%, tSwitch%, sSwitch%, pSwitch%, lSwitch%, oSwitch%, bSwitch%, InputSpec$, OutputSpec$)πCASE 3: Status% = Decode%(oSwitch%, InputSpec$, OutputSpec$)πEND SELECTπIF Status% < 0 THEN ErrLvl% = 8 ELSE IF Status% > 0 THEN ErrLvl% = 9 ELSE ErrLvl% = 0πGOTO AllDoneπShowHelp:πPRINT "Usage: POSTIT [switch] command inputfile [outputfile] [-q" + " options]"πPRINTπPRINT "Commands:"πPRINT "e [E]ncode any file <150k into a self extracting binary script"πPRINT "f [F]ilter QB source into a text script"πPRINT "d [D]ecode captured text or binary script(s)"πPRINTπPRINT "Switches:"πPRINT "-s  Don't split output file into multiple messages"πPRINT "-o  Don't prompt for file overwrites"πPRINT "-b# Reserve # blank lines on first message (0-30, default=0)"πPRINT "-t# Set tab stops to # characters (1-8, default=4)"πPRINT "-l# Set line length to # characters (60-80, default=65 or 72)"πPRINT "-p# Set message length to # lines (45-1000, default=85)"πPRINT "-a  Padd blank lines with a space when filtering"πPRINT "-i  Ignore blank lines when filtering"πPRINT "-c  Crush space characters from start of lines when filtering"πPRINTπPRINT "ImportIt! (QWK compatable .REP file support):"πPRINT "-q [to:to_name] from:from_name conf:conf_num bbsid:BBSID"πAllDone:πIF qSwitch = true THENπ  IF GERR < 0 THENπ    IF Debug% THEN PRINT "Exiting with an errorlevel of"; ErrLvl%π    ENDπ  END IFπ  FOR n = 1 TO 256π    a$ = OutPutFile$(n)π    IF a$ = "" THEN EXIT FORπ  NEXT nπ  NumFiles = n - 1π  DIM MsgFiles$(1 TO NumFiles)π  FOR n = 1 TO NumFilesπ    MsgFiles$(n) = OutPutFile$(n)π  NEXT nπ  FOR n = LEN(InputSpec$) TO 1 STEP -1π    IF MID$(InputSpec$, n, 1) = "\" THEN StartFname = n + 1π  NEXT nπ  IF StartFname <> 0 THENπ    TitleFile$ = MID$(InputSpec$, StartFname, 1)π  ELSEπ    TitleFile$ = InputSpec$π  END IFπ  FOR n = 1 TO LEN(toname$)π    IF MID$(toname$, n, 1) = "." THEN MID$(toname$, n, 1) = " "π  NEXT nπ  FOR n = 1 TO LEN(fromname$)π    IF MID$(fromname$, n, 1) = "." THEN MID$(fromname$, n, 1) = " "π  NEXT nπ  ImportIt BBSID$, MsgFiles$(), toname$, fromname$, TitleFile$, conference%πEND IFπIF Debug% THEN PRINT "Exiting with an errorlevel of"; ErrLvl%πENDπErrHandler: GERR% = ERRπ  IF Debug% THEN IF GERR% <> 53 THEN PRINT "Global error #"; GERR%πRESUME NEXTππSUB AddToRep (BBSID$, MsgFiles$(), toname$, fromname$, TitleFile$, conference, ErrorCode$)π  DIM MsgHeader     AS MsgHeaderTypeπ  DIM QWKRecBuff    AS STRING * 128π  DIM QWKByteBuff   AS STRING * 1π  DIM ArcHeader     AS STRING * 3π  ' test for fileπ  OPEN BBSID$ + ".REP" FOR BINARY AS #1π  IF LOF(1) = 0 THENπ    CLOSE #1π    KILL BBSID$ + ".REP"π    ErrorCode$ = "Reply packet (.REP file) not found!"π    EXIT SUBπ  END IFπ  ' test for messagesπ  NumMessages = UBOUND(MsgFiles$)π  IF NumMessages = 0 THENπ    CLOSE #1π    ErrorCode$ = "No files to add to reply (.REP) packet!"π    EXIT SUBπ  END IFπ  ' check ToName$π  IF toname$ = "" THENπ    toname$ = "ALL"π  END IFπ  ' check FromName$π  IF fromname$ = "" THENπ    CLOSE #1π    ErrorCode$ = "No from field (name) specified!"π    EXIT SUBπ  END IFπ  CLOSE #1π  ' process mail packetπ  PRINTπ  PRINT "Unarchiving "; BBSID$ + ".REP";π  ' determine archive typeπ  OPEN BBSID$ + ".REP" FOR BINARY AS #1π  ' PKZIP file?π  SEEK 1, 1π  GET #1, , ArcHeaderπ  IF ArcHeader = "PK" + CHR$(3) THENπ    DeArcCommand$ = "PKUNZIP"π    ArcCommand$ = "PKZIP"π    ArcType$ = "ZIP"π  END IFπ  ' LZH file?π  SEEK 1, 3π  GET #1, , ArcHeaderπ  IF ArcHeader = "-lh" THENπ    DeArcCommand$ = "LHA E"π    ArcCommand$ = "LHA A /M"π    ArcType$ = "LZH"π  END IFπ  ' ARJ file?π  SEEK 1, 1π  GET #1, , ArcHeaderπ  IF LEFT$(ArcHeader, 2) = "'" + CHR$(234) THENπ    DeArcCommand$ = "ARJ E"π    ArcCommand$ = "ARJ A -Y"π    ArcType$ = "ARJ"π  END IFπ  ' dearchive fileπ  PRINT " using "; ArcType$π  SHELL DeArcCommand$ + " " + BBSID$ + ".REP"π  CLOSE #1π  ' test for fileπ  OPEN BBSID$ + ".MSG" FOR BINARY AS #1π  IF LOF(1) = 0 THENπ    ErrorCode$ = "Error occured during DeArchiving. File " + BBSID$ + ".MSG not found in archive"π    CLOSE #1π    KILL BBSID$ + ".MSG"π    EXIT SUBπ  END IFπ  ' read messagesπ  PRINTπ  PRINT "Reading Messages from "; BBSID$; ".MSG..."π  SEEK 1, 1π  GET #1, , QWKRecBuffπ  DOπ    GET #1, , MsgHeaderπ    NewHighest = VAL(MsgHeader.MsgRefNumber)π    IF NewHighest > Highest THEN Highest = NewHighestπ    ' read until next messageπ    FOR n = 1 TO VAL(MsgHeader.NumBlocks) - 1π      GET #1, , QWKRecBuffπ    NEXT nπ  LOOP UNTIL SEEK(1) >= LOF(1)π  PRINTπ  PRINT "Writing new messages..."π  PRINTπ  PRINT "To:     "π  PRINT "From:   "π  PRINT "Subj:   "π  PRINT "Conf:   "π  PRINT "Date:   "π  PRINT "Time:   "π  PRINT "Number: "π  StartLin = CSRLIN - 7π  FOR msg = 1 TO NumMessagesπ    LOCATE StartLin, 1π    Subj$ = "[" + LTRIM$(STR$(msg)) + "/" + LTRIM$(STR$(NumMessages)) + "] " + TitleFile$π    conf$ = LTRIM$(STR$(conference))π    num$ = LTRIM$(STR$(msg + Highest - 1))π    dat$ = LEFT$(DATE$, 6) + RIGHT$(DATE$, 2)π    tim$ = LEFT$(TIME$, 5)π    PRINT "To:     "; toname$π    PRINT "From:   "; fromname$π    PRINT "Subj:   "; Subj$π    PRINT "Conf:   "; conf$π    PRINT "Date:   "; dat$π    PRINT "Time:   "; tim$π    PRINT "Number: "; num$π    PRINT "Writing File: "; MsgFiles$(msg);π    TotalLen& = 0π    OPEN MsgFiles$(msg) FOR INPUT AS #2π    OPEN "~IIBETA.TMP" FOR BINARY AS #3π    DO WHILE NOT EOF(2)π      LINE INPUT #2, text$π      text$ = text$ + CHR$(227)π      PUT #3, , text$π    LOOPπ    TotalLen& = SEEK(3)π    TotalLen& = TotalLen& + 128       ' for taglineπ    QWKRecBuff = CHR$(227) + " * ImportIt! v1.0b [BETA] * ImportIt!" + " [PD] by Calvin French, August 1993" + CHR$(227) + CHR$(227)π    PUT #3, , QWKRecBuffπ    ExtraString$ = SPACE$(128 - (TotalLen& MOD 128))π    TotalLen& = TotalLen& + LEN(ExtraString$)π    PUT #3, , ExtraString$π    Blocks$ = LTRIM$(STR$((TotalLen& / 128) + 1))π    MsgHeader.Status = "-"            ' public, readπ    MsgHeader.ConfNumASCII = conf$    ' conference (.REP only)π    MsgHeader.MsgDate = dat$          ' dateπ    MsgHeader.MsgTime = tim$          ' timeπ    MsgHeader.ToField = toname$       ' toπ    MsgHeader.FromField = fromname$   ' fromπ    MsgHeader.SubjectField = Subj$    ' subjectπ    MsgHeader.PassWord = SPACE$(12)   ' passwordπ    MsgHeader.MsgRefNumber = num$     ' message numberπ    MsgHeader.NumBlocks = Blocks$     ' blocks in messageπ    MsgHeader.Flag = CHR$(225)        ' active flagπ    MsgHeader.ConfNum = conference    ' conference (.REP and .QWK)π    MsgHeader.PacketMsgNumber = " "   ' not sure what this is.π    MsgHeader.NetworkTag = " "        ' network taglineπ    PUT #1, , MsgHeaderπ    SEEK 3, 1π    FOR n = 1 TO TotalLen& / 128π      GET #3, , QWKRecBuffπ      PUT #1, , QWKRecBuffπ    NEXT nπ    CLOSE #3π    CLOSE #2π    KILL "~IIBETA.TMP"π  NEXT msgπ  CLOSE #1π  PRINTπ  PRINTπ  PRINT "Rearchiving Packet..."π  SHELL ArcCommand$ + " " + BBSID$ + ".REP " + BBSID$ + ".MSG"π  PRINTπ  PRINT "Deleting " + BBSID$ + ".MSG..."π  PRINTπ  KILL BBSID$ + ".MSG"π  ErrorCode$ = "Packet Successfully Processed!"πEND SUBππSUB CreateRep (BBSID$, ArcCommand$)ππDIM QWKRecBuff AS STRING * 128ππPRINTπPRINT "Creating message data file (.MSG file)..."πPRINTππOPEN BBSID$ + ".MSG" FOR BINARY AS #1ππQWKRecBuff = UCASE$(BBSID$)ππPUT #1, , QWKRecBuffππCLOSE #1ππPRINT "Archiving file..."ππSHELL ArcCommand$ + " " + BBSID$ + ".REP " + BBSID$ + ".MSG"ππPRINTπPRINT "Deleting message data file (.MSG file)..."ππKILL BBSID$ + ".MSG"ππEND SUBππFUNCTION Decode% (oSwitch%, InSpec$, OutSpec$)π  DIM Lines$(1 TO 256), ValidChar%(255)π  FOR q% = 0 TO 85 'Valid encoding charactersπ    IF q% = 27 THENπ      ValidChar%(ASC("#")) = trueπ    ELSEIF q% = 59 THENπ      ValidChar%(ASC("$")) = trueπ    ELSEπ      ValidChar%(q% + 37) = trueπ    END IFπ  NEXTπ  GERR% = 0: Z$ = "OPEN " + CHR$(34) + "O" + CHR$(34) + ",1," + CHR$(34)π  SepPath OutSpec$, OutDrive$, OutPath$, OutName$π  OutPath$ = OutDrive$ + OutPath$π  InputHandle% = FREEFILEπ  OPEN InSpec$ FOR INPUT AS InputHandle% LEN = 8192π  OutputHandle% = FREEFILEπ  DOπ    IF FoundNewScript% = false THENπ      DO UNTIL EOF(InputHandle%)π        M% = M% + 1: IF M% = 16 THEN GOSUB AbortCheckπ        LineNum& = LineNum& + 1π        LINE INPUT #1, a$: a$ = LTRIM$(RTRIM$(UCASE$(a$)))π        IF GERR% THEN PRINT "Error while reading from input file!": GOTO DecodeExitπ        IF LEFT$(a$, 14) = "'>>> PAGE 1 OF" AND INSTR(a$, "BEGINS" + " HERE") > 0 AND INSTR(a$, "TYPE:") > 0 THEN EXIT DOπ      LOOPπ      IF EOF(InputHandle%) THEN EXIT DOπ    END IFπ    FoundNewScript% = falseπ    OutFile$ = LTRIM$(MID$(a$, 15))π    OutFile$ = RTRIM$(LEFT$(OutFile$, INSTR(OutFile$, "BEGINS") - 1))π    IF LEN(OutFile$) = 0 THEN GOTO FindNextπ    IF LEN(OutName$) = 0 OR OutFile$ = OutName$ THENπ      FilesCRC% = -1: FilesLength& = -1: ScrDone% = falseπ      BadScript% = false: NumLines% = 0: K% = 0: s% = 0: B& = 0π      q% = INSTR(a$, "TYPE:") + 5π      SELECT CASE MID$(a$, q%, 3)π      CASE "BAS": ScriptType% = 0π      CASE "BIN"π        ScriptType% = 1π        EncodeVer% = FASC%(MID$(a$, q% + 3, 1)) - 65π        ExtractVer% = FASC%(MID$(a$, q% + 4, 1)) - 65π        IF ExtractVer% <> 0 THEN PRINT "Unsupported encoding algorithm" + "" + " for file "; OutFile$: PRINT : GOTO FindNextπ      CASE ELSE: PRINT "Unsupported script type for file "; OutFile$: PRINT : GOTO FindNextπ      END SELECTπ      GOSUB CheckLineπ      OPEN OutPath$ + OutFile$ FOR INPUT AS OutputHandle%: CLOSE OutputHandle%π      IF GERR% = 0 THENπ        IF oSwitch% = false THENπ          PRINT OutPath$ + OutFile$; " already exists. [O]verwrite, or" + "" + " [A]bort(o/a)? ";π          DO: DO: a$ = INKEY$: LOOP UNTIL LEN(a$): a$ = UCASE$(a$)π          LOOP UNTIL INSTR("OA" + CHR$(27), a$)π          LOCATE , 1: PRINT SPACE$(78); : LOCATE , 1π          SELECT CASE a$π          CASE "A", CHR$(27): GERR% = -1: PRINT "Aborted by user!": GOTO DecodeExitπ          END SELECTπ        END IFπ      END IFπ      GERR% = 0: OPEN OutPath$ + OutFile$ FOR OUTPUT AS OutputHandle%π      IF GERR% THEN PRINT "Error while opening "; OutPath$ + OutFile$; "!": GOTO DecodeExitπ      OutSpecOpened% = trueπ      IF ScriptType% = 0 THEN PRINT "Unfiltering ";  ELSE PRINT "Decoding ";π      PRINT OutPath$ + OutFile$; "... ";π      LookingForNextPage% = falseπ      CurrentPage% = 1π      DO UNTIL EOF(InputHandle%)π        IF GERR% THEN PRINT "Error #"; STR$(GERR%); " while processing" + "" + " file!": GOTO DecodeExitπ        M% = M% + 1: IF M% = 16 THEN GOSUB AbortCheckπ        LineNum& = LineNum& + 1π        LINE INPUT #InputHandle%, a$: a$ = RTRIM$(a$)π        IF ScriptType% = 1 THEN a$ = LTRIM$(a$)π        IF LEFT$(a$, 4) = "'>>>" THENπ          GOSUB CheckLineπ          IF UCASE$(LEFT$(a$, 10)) = "'>>> PAGE " THENπ            a$ = UCASE$(a$)π            IF LEFT$(a$, 15) = "'>>> PAGE 1 OF " AND INSTR(a$, "BEGINS" + "" + " HERE") > 0 THENπ              PRINT "Premature end of script on line"; LineNum&π              FoundNewScript% = true: BadScript% = true: EXIT DOπ            END IFπ            IF GrabNum&(MID$(a$, 11), 1, 256, -1) <> CurrentPage% THEN PRINT "Page out of sync on line"; LineNum&: BadScript% = true: EXIT DOπ            IF INSTR(a$, "BEGINS HERE") THENπ              IF LookingForNextPage% = false THEN PRINT "Page"; CurrentPage%; " was encountered more than once on line"; LineNum&: BadScript% = true: EXIT DOπ              LookingForNextPage% = falseπ            ELSEIF INSTR(a$, "ENDS HERE") THENπ              IF LookingForNextPage% = true THEN PRINT "Page"; CurrentPage%; "was terminated prematurely on line"; LineNum&: BadScript% = true: EXIT DOπ              LookingForNextPage% = trueπ              CurrentPage% = CurrentPage% + 1π              IF INSTR(a$, "LAST PAGE") THEN ScrDone% = true: EXIT DOπ            ELSEπ              PRINT "Bad page header on line"; LineNum&: BadScript% = true: EXIT DOπ            END IFπ          END IFπ        ELSEπ          IF LookingForNextPage% = false THENπ            IF ScriptType% = 0 THENπ              GOSUB ShrinkLineπ            ELSEπ              IF LEFT$(a$, 1) = "U" AND LEFT$(LTRIM$(MID$(a$, 2)), 1) = CHR$(34) THEN GOSUB DecodeLineπ            END IFπ          END IFπ        END IFπ      LOOPπ      IF BadScript% = false THENπ        IF ScrDone% = false THEN PRINT "Premature end of script on" + " line"; LineNum&: BadScript% = true: GOTO DecodeDoneπ        GoodScripts% = GoodScripts% + 1π        IF ScriptType% = 0 THENπ          IF NumLines% > 0 THEN a$ = "": GOSUB ShrinkLineπ          PRINT "Ok"π        ELSEπ          IF FilesLength& = -1 THENπ            PRINT "Warning: File's length could not be located!"π          ELSEIF FilesLength& <> B& THENπ            PRINT "Warning: Decoded file's length is incorrect."π          ELSEIF FilesCRC% = -1 THENπ            PRINT "Warning: File's checksum could not be located!"π          ELSEIF FilesCRC% <> s% THENπ            PRINT "Warning: Decoded file's checksum is incorrect."π          ELSEπ            PRINT "Ok"π          END IFπ        END IFπ      END IFπDecodeDone:π      CLOSE OutputHandle%π      IF GERR% THEN PRINT "Error while writing to output file!": GOTO DecodeExitπ      IF BadScript% THEN KILL OutPath$ + OutFile$π      OutSpecOpened% = falseπ      PRINT : IF OutFile$ = OutName$ THEN EXIT DOπ    END IFπFindNext:π  LOOP UNTIL EOF(InputHandle%)π'----------------------------------------------------------πDecodeExit:π  q% = GERR%: CLOSE InputHandle%: CLOSE OutputHandle%π  IF q% = 0 THEN PRINT LTRIM$(STR$(GoodScripts%)); " script(s) decoded" + "" + " successfully."π  IF q% <> 0 AND OutSpecOpened% THEN KILL OutPath$ + OutFile$π  Decode% = q%πEXIT FUNCTIONπ'----------------------------------------------------------πShrinkLine:π  FoundIt% = FASC(RIGHT$(a$, 1)) = 95π  IF FoundIt% THENπ    InQuote% = falseπ    FOR I% = 1 TO LEN(a$)π      IF MID$(a$, I%, 1) = CHR$(34) THEN InQuote% = NOT InQuote%π    NEXTπ    'Don't combine lines that are part of binary scriptsπ    IF InQuote% THEN FoundIt% = falseπ  END IFπ  IF FoundIt% OR NumLines% > 0 THENπ    IF NumLines% = 256 THENπ      PRINT "Too many line continuations!": BadScript% = true: GOTO DecodeDoneπ    END IFπ    NumLines% = NumLines% + 1: Lines$(NumLines%) = a$π    IF FoundIt% = false THEN 'last line?π      a$ = ""π      FOR a% = 1 TO NumLines%π        B$ = Lines$(a%)π        'can we combine two quoted strings together?π        CombineQuote% = falseπ        IF RIGHT$(a$, 2) = "+_" AND LEN(a$) > 3 THENπ          IF RIGHT$(RTRIM$(LEFT$(a$, LEN(a$) - 2)), 1) = CHR$(34) THENπ            IF FASC(LTRIM$(B$)) = 34 THEN CombineQuote% = trueπ          END IFπ        END IFπ        IF CombineQuote% THENπ          a$ = RTRIM$(LEFT$(a$, LEN(a$) - 2))π          a$ = LEFT$(a$, LEN(a$) - 1) + MID$(LTRIM$(B$), 2)π        ELSEπ          InQuote% = falseπ          'can we combine two remarks together?π          FOR I% = 1 TO LEN(a$)π            q$ = MID$(a$, I%, 1)π            IF q$ = CHR$(34) THENπ              InQuote% = NOT InQuote%π            ELSEIF InQuote% = false THENπ              IF q$ = "'" OR UCASE$(MID$(a$, I%, 4)) = "REM " THENπ                IF LEFT$(LTRIM$(B$), 1) = "'" THEN B$ = MID$(B$, 2)π                EXIT FORπ              END IFπ            END IFπ          NEXTπ          'eradicate trailing "_" characterπ          IF LEN(a$) THEN a$ = LEFT$(a$, LEN(a$) - 1)π          a$ = a$ + B$π        END IFπ      NEXTπ      PRINT #OutputHandle%, a$: NumLines% = 0π    END IFπ  ELSEπ    PRINT #OutputHandle%, a$π  END IFπ  IF GERR% THEN PRINT "Error while writing to output file!": GOTO DecodeExitπRETURNπ'----------------------------------------------------------πDecodeLine: '**MOD 86 Decoder**π  a$ = MID$(LTRIM$(MID$(a$, 2)), 2)π  IF RIGHT$(a$, 1) = CHR$(34) THEN a$ = LEFT$(a$, LEN(a$) - 1)π  FOR a% = 1 TO LEN(a$)π    C% = ASC(MID$(a$, a%, 1))π    IF ValidChar%(C%) = false THEN PRINT "Illegal character found on" + " line"; LineNum&: BadScript% = true: GOTO DecodeDoneπ    C% = C% - 37: IF C% < 0 THEN C% = 91 + C% * 32π    IF K% < 4 THENπ      IF C% > 80 THEN PRINT "Decode out of sync/illegal character" + " found" + " on line"; LineNum&: BadScript% = true: GOTO DecodeDoneπ      K% = C% + 243π    ELSEπ      T% = C% + (K% MOD 3) * 86: IF T% > 255 THEN PRINT "Illegal" + " character found on line"; LineNum&: BadScript% = true: GOTO DecodeDoneπ      PRINT #OutputHandle%, CHR$(T%);π      IF GERR% THEN PRINT "Error while writing to output file!": GOTO DecodeExitπ      B& = B& + 1: K% = K% \ 3π    END IFπ    s% = (s% + C%) AND 255π  NEXTπRETURNπ'----------------------------------------------------------πCheckLine:π  q% = INSTR(a$, "TLEN:")π  IF q% THEN FilesLength& = GrabNum&(MID$(a$, q% + 5), 1, 153600, -1)π  q% = INSTR(a$, "TCHK:")π  IF q% THEN FilesCRC% = GrabNum&(MID$(a$, q% + 5), 0, 255, -1)πRETURNπ'----------------------------------------------------------πAbortCheck: M% = 0: K$ = INKEY$π  IF K$ = CHR$(27) OR K$ = CHR$(0) + CHR$(0) THEN GERR% = -1: PRINT "Aborted by user!": GOTO DecodeExitπRETURNπEND FUNCTIONππFUNCTION Encode% (Op%, iSwitch%, cSwitch%, aSwitch%, tSwitch%, sSwitch%, pSwitch%, lSwitch%, oSwitch%, bSwitch%, InSpec$, OutSpec$)π  ' following SHARED is for ImportIt!π  DIM Bucket%(1 TO 4), Lines$(64)π  GERR% = 0: q$ = CHR$(34)π'----------------------------------------------------------π  SepPath InSpec$, OutDrive$, OutPath$, InName$π  SepPath OutSpec$, OutDrive$, OutPath$, OutName$π  IF LEN(OutName$) = 0 THENπ    OutName$ = InName$π    IF INSTR(OutName$, ".") THEN OutName$ = LEFT$(OutName$, INSTR(OutName$, ".") - 1)π  END IFπ  IF INSTR(OutName$, ".") THENπ    OutExt$ = MID$(OutName$, INSTR(OutName$, "."))π    OutName$ = LEFT$(OutName$, INSTR(OutName$, ".") - 1)π  END IFπ  IF LEN(OutExt$) = 0 THEN IF Op% THEN OutExt$ = ".PST" ELSE OutExt$ = ".PI"π'----------------------------------------------------------π  InputHandle% = FREEFILEπ  IF Op% THENπ    OPEN InSpec$ FOR INPUT AS InputHandle% LEN = 8192π  ELSEπ    OPEN InSpec$ FOR BINARY AS InputHandle%π  END IFπ  InputFileSize& = LOF(InputHandle%)π  IF Op% = 0 AND InputFileSize& > (150 * 1024&) THENπ    PRINT "Can't encode files larger than 150k."π    GERR% = -1: GOTO EncodeExitπ  ELSEIF InputFileSize& = 0 THENπ    PRINT "Input file is null.": GERR% = -2: GOTO EncodeExitπ  END IFπ'----------------------------------------------------------π  IF Op% THEN PRINT "Filtering ";  ELSE PRINT "Encoding ";π  PRINT InSpec$; " ("; LTRIM$(STR$((InputFileSize& + 1023) \ 1024)); "k)"π  PRINTπ'----------------------------------------------------------π  OutputHandle% = FREEFILE: LinesInPage% = 0π'----------------------------------------------------------π  IF Op% = 0 THENπ    Work$ = "U" + q$ + SPACE$(lSwitch% - 2): WorkPos% = 3π    CurrentSub% = 0: LinesInSub% = 0: FlagScaler% = 1π    GOSUB PrintDecodeHeaderπ    BytesLeft& = InputFileSize&: BufferSize% = 4096π    Buffer$ = SPACE$(BufferSize)π    DOπ      IF GERR% THEN PRINT "- Error #"; STR$(GERR%); " while encoding" + " file!": GOTO EncodeExitπ      IF BytesLeft& < BufferSize% THEN Buffer$ = SPACE$(BytesLeft&): BufferSize% = BytesLeft&π      GET InputHandle%, , Buffer$π      IF GERR% THEN PRINT "- Error while reading from input file!": GOTO EncodeExitπ      GOSUB EncodeBlockπ    LOOP WHILE BytesLeft&π    IF NumCodes% THEN GOSUB FlushCodeBufferπ    IF WorkPos% > 3 THEN Work$ = LEFT$(Work$, WorkPos% - 1): GOSUB PutSubLineπ    IF LinesInSub% THEN L$ = "END SUB": GOSUB PutLineπ    FOR a% = 2 TO CurrentSub%: L$ = "V" + HEX$(a%): GOSUB PutLine: NEXTπ    GOSUB PrintDecodeTrailerπ  ELSEπ    BytesLeft& = InputFileSize&π    DO UNTIL EOF(InputHandle)π      IF GERR% THEN PRINT "- Error #"; STR$(GERR%); " while filtering" + "" + " file!": GOTO EncodeExitπ      LINE INPUT #InputHandle, a$: a$ = RTRIM$(UnTab$(a$, tSwitch%))π      IF GERR% THEN PRINT "- Error while reading from input file!": GOTO EncodeExitπ      IF cSwitch% THEN a$ = LTRIM$(a$)π      BytesLeft& = BytesLeft& - LEN(a$) - 2π      IF LEN(a$) > 0 OR iSwitch% = false THENπ        ExpandLine a$, Lines$(), lSwitch%, NumLines%π        'Don't let split lines cross page boundries, because QB won'tπ        'put them back together.π        IF sSwitch% = false AND (NumLines% > 1) AND (LinesInPage% + 1 + NumLines%) > pSwitch% THENπ          PRINT #OutputHandle%, "'>>> Page"; STR$(NumOutputFiles%); " of "; InName$; " ends here. Continued on next page."π          LinesInPage% = LinesInPage% + 1: GOSUB CloseOutputFileπ        END IFπ        FOR a% = 1 TO NumLines%π          L$ = Lines$(a%)π          'Don't let blank lines proceed the first page header.π          IF LinesInPage% <> 0 OR LEN(RTRIM$(L$)) > 0 THENπ            'The padding option is for those unfortunates that postπ            'source online in RBBS's grubby line oriented text editor...π            IF aSwitch% THEN IF LEN(L$) = 0 THEN L$ = " "π            GOSUB PutLineπ          END IFπ        NEXTπ      END IFπ    LOOPπ  END IFπ'----------------------------------------------------------π  L$ = "'>>> Page" + STR$(NumOutputFiles%) + " of " + InName$ + " ends" + "" + " here. Last page."π  IF Op% = 0 THEN L$ = L$ + " TCHK:" + LTRIM$(STR$(CheckSum%))π  GOSUB PutLine: GOSUB CloseOutputFile: PRINTπ  PRINT LTRIM$(STR$(TotalLines%)); " lines in"; STR$(NumOutputFiles%); " message(s) written."π'----------------------------------------------------------πEncodeExit:π  q% = GERR%π  CLOSE InputHandle%: CLOSE OutputHandle%π  IF q% <> 0 THEN FOR a% = 1 TO NumOutputFiles%: KILL OutPutFile$(a%): NEXTπ  Encode% = q%πEXIT FUNCTIONπ'----------------------------------------------------------πEncodeBlock: '**MOD 86 Encoder**π  FOR I% = 1 TO BufferSize%π    Byte% = ASC(MID$(Buffer$, I%, 1)): BytesLeft& = BytesLeft& - 1π    CurrentFlag% = CurrentFlag% + (Byte% \ 86) * FlagScaler%π    FlagScaler% = FlagScaler% * 3: NumCodes% = NumCodes% + 1π    Bucket%(NumCodes%) = Byte% MOD 86π    IF NumCodes% = 4 THEN GOSUB FlushCodeBufferπ  NEXTπRETURNπ'----------------------------------------------------------πFlushCodeBuffer:π  q% = CurrentFlag%: GOSUB PutByteπ  FOR J% = 1 TO NumCodes%: q% = Bucket%(J%): GOSUB PutByte: NEXTπ  NumCodes% = 0: CurrentFlag% = 0: FlagScaler% = 1πRETURNπ'----------------------------------------------------------πPutByte:π  CheckSum% = (CheckSum% + q%) AND 255π  IF q% = 27 THENπ    MID$(Work$, WorkPos%) = "#"π  ELSEIF q% = 59 THENπ    MID$(Work$, WorkPos%) = "$"π  ELSEπ    MID$(Work$, WorkPos%) = CHR$(q% + 37)π  END IFπ  WorkPos% = WorkPos% + 1: IF WorkPos% > lSwitch% THEN GOSUB PutSubLineπRETURNπ'----------------------------------------------------------πPutSubLine:π  IF LinesInSub% = 0 THENπ    CurrentSub% = CurrentSub% + 1π    IF CurrentSub% = 1 THENπ      L$ = "SUB V1:OPEN " + q$ + "O" + q$ + ",1," + q$ + InName$ + q$ + ",4^6:Z&=" + LTRIM$(STR$(LOF(1))) + ":?STRING$(50,177);"π    ELSEπ      L$ = "SUB V" + HEX$(CurrentSub%)π    END IFπ    GOSUB PutLineπ  END IFπ  L$ = Work$: GOSUB PutLineπ  LinesInSub% = LinesInSub% + 1π  IF LinesInSub% = 200 THEN L$ = "END SUB": GOSUB PutLine: LinesInSub% = 0π  WorkPos% = 3πRETURNπ'----------------------------------------------------------πPutLine:π  IF LinesInPage% = 0 THEN GOSUB OpenNewOutputFileπ  PRINT #OutputHandle%, L$π  IF GERR% THEN PRINT "- Error writing to output file!": GOTO EncodeExitπ  LinesInPage% = LinesInPage% + 1π  IF sSwitch% = false THENπ    'make sure last page has some meat on itπ    IF LinesInPage% = (pSwitch% - 1) OR (BytesLeft& < 256 AND LinesInPage% > (pSwitch% - 10)) THENπ      PRINT #OutputHandle%, "'>>> Page"; STR$(NumOutputFiles%); " of "; InName$; " ends here. Continued on next page."π      LinesInPage% = LinesInPage% + 1: GOSUB CloseOutputFileπ    END IFπ  END IFπ  'Check the blower for contol+c and escape every few lines...π  IF (LinesInPage% AND 7) = 1 THENπ    a$ = INKEY$: IF a$ = CHR$(27) OR a$ = CHR$(0) + CHR$(0) THEN GERR% = -3: PRINT "- Aborted by user!": GOTO EncodeExitπ  END IFπRETURNπ'----------------------------------------------------------πOpenNewOutputFile:π  IF NumOutputFiles% = 256 THEN GERR% = -4: PRINT "Too many output" + " files!": GOTO EncodeExitπ  NumOutputFiles% = NumOutputFiles% + 1π  IF sSwitch% = true THENπ    J$ = OutName$π  ELSEπ    J$ = LTRIM$(STR$(NumOutputFiles%))π    J$ = LEFT$(OutName$, 8 - LEN(J$)) + J$π  END IFπ  OutFile$ = OutDrive$ + OutPath$ + J$ + OutExt$: GERR% = 0π  OPEN OutFile$ FOR INPUT AS OutputHandle%: CLOSE OutputHandle%π  IF GERR% = 0 THENπ    IF oSwitch% = false THENπ      PRINT OutFile$; " already exists. [O]verwrite, overwrite [R]est," + "" + " or [A]bort(o/r/a)? ";π      DO: DO: a$ = INKEY$: LOOP UNTIL LEN(a$): a$ = UCASE$(a$)π      LOOP UNTIL INSTR("ORA" + CHR$(27), a$)π      LOCATE , 1: PRINT SPACE$(78); : LOCATE , 1π      SELECT CASE a$π      CASE "A", CHR$(27): GERR% = -3: PRINT "Aborted by user!"π        NumOutputFiles% = NumOutputFiles% - 1: GOTO EncodeExitπ      CASE "R": oSwitch% = trueπ      END SELECTπ    END IFπ  END IFπ  PRINT "Now writing: "; OutFile$; " ";π  GERR% = 0: OPEN OutFile$ FOR OUTPUT AS OutputHandle% LEN = 4096π  OutPutFile$(NumOutputFiles%) = OutFile$π  IF GERR% THENπ    PRINT "- Error opening output file!"π    NumOutputFiles% = NumOutputFiles% - 1: GOTO EncodeExitπ  END IFπ  LinesInPage% = 1π  IF NumOutputFiles% = 1 THENπ    FOR I% = 1 TO bSwitch%π      IF aSwitch% THEN PRINT #OutputHandle, " " ELSE PRINT #OutputHandle,π    NEXTπ    LinesInPage% = LinesInPage% + bSwitch%π  END IFπ  PRINT #OutputHandle%, "'>>> Page"; STR$(NumOutputFiles%); " of "; InName$; " begins here.";π  IF NumOutputFiles% > 1 THENπ    PRINT #OutputHandle%,π  ELSEπ    IF Op% = 0 THENπ      'The first letter after "BIN" is  which algorithm was usedπ      'to encode the file. The second letter is the minimum decodingπ      'algorithm required to extract the file. Both range from A-Z.π      PRINT #OutputHandle%, " TYPE:BINAA";π      'TLEN stands for "total length".π      PRINT #OutputHandle%, " TLEN:"; LTRIM$(STR$(InputFileSize&))π      'In the future, other information may be put onto this line,π      'such as the file's date and time. (Actually, any lineπ      'starting will "'>>>" will be scanned for information byπ      'the Decode function.)π    ELSEπ      PRINT #OutputHandle%, " TYPE:BAS"π    END IFπ  END IFπ  GERR% = 0πRETURNπ'----------------------------------------------------------πCloseOutputFile:π  CLOSE OutputHandle%π  IF GERR% THEN PRINT "- Error while writing to output file!": GOTO EncodeExitπ  PRINT : TotalLines% = TotalLines% + LinesInPage%: LinesInPage% = 0πRETURNπ'----------------------------------------------------------πPrintDecodeHeader:π  L$ = "DEFINT A-Z:DIM SHARED K,S,B&,Z&:V1 'Created by PostIt! 7.1"π  GOSUB PutLineπRETURNπ'----------------------------------------------------------πPrintDecodeTrailer:π  L$ = "CLOSE:IF S=" + LTRIM$(STR$(CheckSum%))π  L$ = L$ + "AND B&=Z&THEN?" + q$ + " :) Ok!" + q$ + "ELSE?" + q$ + " " + "" + ":( Bad!"π  GOSUB PutLineπ  L$ = "SUB U(A$):FOR A=1TO LEN(A$):C=ASC(MID$(A$,A))-37:IF C<0THEN" + " C=91+C*32"π  GOSUB PutLineπ  L$ = "IF K<4THEN K=C+243ELSE?#1,CHR$(C+(K MOD 3)*86);:K=K\3:B&=B&+1"π  GOSUB PutLineπ  L$ = "S=(S+C)AND 255:NEXT:LOCATE,1:?STRING$(B&*50\Z&,219);:END SUB"π  GOSUB PutLineπRETURNπEND FUNCTIONππ'This self containted subroutine for splitting QB lines was made byπ'Victor Yiu and a few other folks on the QUIK_BAS echo.πSUB ExpandLine (a$, Lines$(), LineLength%, NumLines%)π  NumLines% = 0π  'check to see if the line has already been splitπ  FOR I% = LEN(a$) TO 1 STEP -1π    SELECT CASE MID$(a$, I%, 1)π    CASE "_": NoSplit% = trueπ    CASE " "π    CASE ELSE: EXIT FORπ    END SELECTπ  NEXTπ  DO WHILE NoSplit% = false AND LEN(a$) > LineLength%π    'locate a place to split the lineπ    WrapPoint% = 0π    FOR I% = LineLength% TO LineLength% - 20 STEP -1π      SELECT CASE MID$(a$, I%, 1)π      CASE " ", ".", ",", ":", ";": WrapPoint% = I%: EXIT FORπ      END SELECTπ    NEXTπ    IF WrapPoint% = 0 THEN WrapPoint% = LineLength%π    'avoid wrapping on quote charsπ    IF MID$(a$, WrapPoint% - 1, 1) = CHR$(34) THEN WrapPoint% = WrapPoint% - 1π    InQuote% = false: HasComment% = falseπ    'check to see if the line contains a remarkπ    FOR I% = 1 TO WrapPoint% - 1π      q$ = MID$(a$, I%, 1)π      IF q$ = CHR$(34) THENπ        InQuote% = NOT InQuote%π      ELSEIF InQuote% = false THENπ        IF q$ = "'" OR UCASE$(MID$(a$, I%, 4)) = "REM " THENπ          HasComment% = true: EXIT FORπ        END IFπ      END IFπ    NEXTπ    NumLines% = NumLines% + 1π    IF InQuote% THENπ      Lines$(NumLines%) = LEFT$(a$, WrapPoint% - 1) + CHR$(34) + "+_"π    ELSEπ      Lines$(NumLines%) = LEFT$(a$, WrapPoint% - 1) + "_"π    END IFπ    a$ = MID$(a$, WrapPoint%)π    IF HasComment% THENπ      a$ = "'" + a$π    ELSEIF InQuote% THENπ      a$ = CHR$(34) + a$π    END IFπ  LOOPπ  NumLines% = NumLines% + 1: Lines$(NumLines%) = a$πEND SUBππFUNCTION FASC% (a$)π  IF LEN(a$) = 0 THEN FASC% = -1 ELSE FASC% = ASC(a$)πEND FUNCTIONππFUNCTION GrabNum& (a$, Lower&, Upper&, Default&)π  FOR I% = 1 TO LEN(a$)π    q$ = MID$(a$, I%, 1): IF (q$ < "0" OR q$ > "9") THEN EXIT FORπ    J& = J& * 10& + ASC(q$) - 48π    IF J& > Upper& THEN GrabNum& = Default&: EXIT FUNCTIONπ  NEXTπ  GrabNum& = J&: IF LEN(a$) = 0 OR J& < Lower& OR J& > Upper& THEN GrabNum& = Default&πEND FUNCTIONππSUB IIParse (cmd$, toname$, fromname$, conference%, BBSID$)π  ' this short sub parses cmd$ and returns values for use with ImportIt!π  FOR n = 1 TO LEN(cmd$)π    IF MID$(cmd$, n, 4) = " -Q " THENπ      qLoc = n + 4π    END IFπ  NEXT nπ  FOR n = qLoc TO LEN(cmd$)π    IF MID$(cmd$, n, 3) = "TO:" THENπ      toname$ = LTRIM$(RTRIM$(MID$(cmd$, n + 3, INSTR(n, cmd$, "FROM:") - (n + 3))))π    ELSEIF MID$(cmd$, n, 5) = "FROM:" THENπ      fromname$ = LTRIM$(RTRIM$(MID$(cmd$, n + 5, INSTR(n, cmd$, "CONF" + ":") - (n + 5))))π    ELSEIF MID$(cmd$, n, 5) = "CONF:" THENπ      conference% = VAL(LTRIM$(RTRIM$(MID$(cmd$, n + 5, INSTR(n, cmd$, "BBSID:") - (n + 5)))))π    ELSEIF MID$(cmd$, n, 6) = "BBSID:" THENπ      BBSID$ = LTRIM$(RTRIM$(LTRIM$(RTRIM$(MID$(cmd$, n + 6)))))π    END IFπ  NEXT nπEND SUBππSUB ImportIt (BBSID$, MsgFiles$(), toname$, fromname$, TitleFile$, conference)π  PRINTπ  PRINT "ImportIt! v1.0"; CHR$(225); " QuickBASIC Compatable QWK format" + " file importer."π  PRINT "For use with PostIt! QuickBASIC Compatable Encoder/Decoder."π  PRINT "Public Domain by Calvin French, August 1993"π  PRINTπ  PRINT "Adding encoded files to reply packet (.REP file)"π  AddToRep BBSID$, MsgFiles$(), toname$, fromname$, TitleFile$, conference, ErrorCode$π  PRINTπ  PRINT "Status returned: "; ErrorCode$π  IF ErrorCode$ = "Reply packet (.REP file) not found!" THENπ    ArcMethod$ = PreferredArchiveMethod$π    SELECT CASE ArcMethod$π      CASE "ARJ"π        ArcCommand$ = "ARJ A"π      CASE "LHA"π        ArcCommand$ = "LHA A"π      CASE "ZIP"π        ArcCommand$ = "PKZIP"π    END SELECTπ    CreateRep BBSID$, ArcCommand$π    AddToRep BBSID$, MsgFiles$(), toname$, fromname$, TitleFile$, conference, ErrorCode$π    PRINT "Status returned: "; ErrorCode$π    PRINTπ  END IFπEND SUBππ'This parsing sub does NOT mistake filenames like "F-14G.ZIP" asπ'containing a switch. That's why it looks so big.πSUB ParseCmdLine (cmd$, Params$(), Found%)π  Found% = 0: Sep$ = "-/": Temp$ = LTRIM$(RTRIM$(cmd$)): InParam% = 0π  FOR p% = 1 TO LEN(Temp$)π    C$ = MID$(Temp$, p%, 1)π    IF InParam% = -1 THEN 'Inside of a switch?π      IF INSTR(Sep$, C$) THEN 'Found another switch?π        'Terminate current switch, then start parsing the next one.π        GOSUB MakeParam: MID$(Temp$, p%, 1) = LEFT$(Sep$, 1)π        ParamStart% = p%π      ELSEIF ASC(C$) = 32 OR ASC(C$) = 9 THENπ        GOSUB MakeParam: InParam% = 0 'Terminate current switch.π      END IFπ    ELSEIF InParam% = -2 THEN 'Inside of a parameter?π      IF ASC(C$) = 32 OR ASC(C$) = 9 THEN 'Terminate parameter withπ        GOSUB MakeParam: InParam% = 0     'space or TAB.π      END IFπ    ELSEπ      IF INSTR(Sep$, C$) THEN 'Found start of a switch?π        'Make sure all switches start with "-".π        MID$(Temp$, p%, 1) = LEFT$(Sep$, 1): InParam% = -1π        ParamStart% = p%π      ELSEIF ASC(C$) <> 32 AND ASC(C$) <> 9 THEN 'If char isn't aπ        InParam% = -2: ParamStart% = p% 'space or TAB it's a parameter.π      END IFπ    END IFπ  NEXTπ IF InParam% THEN GOSUB MakeParamπ  EXIT SUBπMakeParam:π  Found% = Found% + 1π  Params$(Found%) = MID$(Temp$, ParamStart%, p% - ParamStart%)π  IF Found% = UBOUND(Params$) THEN EXIT SUBπRETURNπEND SUBππSUB SepPath (a$, Drive$, path$, tName$)π  FOR I% = LEN(a$) TO 1 STEP -1π    IF INSTR("\:", MID$(a$, I%, 1)) THEN EXIT FORπ  NEXTπ  IF I% > 0 THENπ    path$ = UCASE$(MID$(a$, 1, I%)): tName$ = UCASE$(MID$(a$, I% + 1))π  ELSEπ    path$ = "": tName$ = UCASE$(a$)π  END IFπ  Temp% = INSTR(path$, ":"): Drive$ = ""π  IF Temp% THEN Drive$ = LEFT$(path$, Temp%): path$ = MID$(path$, Temp% + 1)πEND SUBππFUNCTION UnTab$ (B$, TabStops%)π  a$ = B$: T% = INSTR(a$, CHR$(9))π  IF T% THENπ    DO: Temp% = (T% - 1) MOD TabStops%π    a$ = LEFT$(a$, T% - 1) + SPACE$(TabStops% - Temp%) + MID$(a$, T% + 1)π    T% = INSTR(T%, a$, CHR$(9)): LOOP WHILE T%π  END IFπ  UnTab$ = a$πEND FUNCTION '(last subroutine)ππGarry Spencer                  CALCULATES DAY OF THE WEEK     [e-mail]        Unknown Date           QB, QBasic, PDS        87   2349     WEEKDAY.BAS 'WEEKDAY.BAS - Function to calculate the day of the week when given theπ'              date in integer form: Mon%, Day%, Year% (year: 1582 to 2450)π'              Note: Returns (0=Sunday...6=Saturday)  or -1 if an error occursπ'              Written by: Garry Spencer ([e-mail])ππ'To compile & link (stand-alone OBJ):       BC WEEKDAY;π π'To add the WEEKDAY function to a library:  LIB libname +WEEKDAY;π π'To compile a user program:                 BC progname/O;π'and add the WEEKDAY function to it:        LINK/EX progname WEEKDAY;π π'To Use:πDECLARE FUNCTION WEEKDAY% (Mon%, Day%, Year%)   'do not use BYVALπ'Example:πCLSπPRINT : LOCATE 12, 12πINPUT ; "Enter date (mm,dd,yyyy): ", Mon%, Day%, Year%πDWeek% = WEEKDAY%(Mon%, Day%, Year%)πPRINT " is a ";ππSELECT CASE DWeek%π    CASE 0π        PRINT "Sunday."π    CASE 1π        PRINT "Monday."π    CASE 2π        PRINT "Tuesday."π    CASE 3π        PRINT "Wednesday."π    CASE 4π        PRINT "Thursday."π    CASE 5π        PRINT "Friday."π    CASE 6π        PRINT "Saturday."π    CASE ELSEπ        PRINT "Error"π    END SELECTππFUNCTION WEEKDAY% (Mon%, Day%, Year%)πDTmp% = 4: Days% = 0: Ofs% = 0: Leap% = 0: WEEKDAY% = -1πIF Year% < 1582 OR Year% > 2450 OR Mon% < 1 OR Mon% > 12 OR Day% < 1 THEN EXIT FUNCTIONπFOR YTmp% = 1582 TO Year%π    DTmp% = (DTmp% + 1 + Leap%) MOD 7π        SELECT CASE 0π            CASE (YTmp% MOD 400)π                Leap% = 1π            CASE (YTmp% MOD 100)π                Leap% = 0π            CASE (YTmp% MOD 4)π                Leap% = 1π            CASE ELSEπ                Leap% = 0π        END SELECTπNEXT YTmp%πFOR MTmp% = 1 TO Mon%: Ofs% = Ofs% + Days%π    SELECT CASE MTmp%π        CASE 1π            Days% = 31:π        CASE 2π            Days% = 28 + Leap%:π        CASE 3π            Days% = 31π        CASE 4π            Days% = 30:π        CASE 5π            Days% = 31:π        CASE 6π            Days% = 30π        CASE 7π            Days% = 31:π        CASE 8π            Days% = 31:π        CASE 9π            Days% = 30π        CASE 10π            Days% = 31π        CASE 11π            Days% = 30:π        CASE 12π            Days% = 31π    END SELECTπNEXT MTmp%πIF Day% <= Days% THEN WEEKDAY% = (DTmp% + Ofs% + Day% - 1) MOD 7πEND FUNCTIONππChris Tracy                    HOW MANY DAYS                  FidoNet QUIK_BAS Echo          Year of 1993           QB, QBasic, PDS        85   2350     DAYS.BAS    DECLARE SUB Days (M1, D1, Y1, M2, D2, Y2, N)π πDays 1, 1, 85, 1, 3, 93, NumberπPRINT "The number of days between 1/1/85 and 1/1/93 is:"; Numberπ πSUB Days (M1, D1, Y1, M2, D2, Y2, N)π' How Many Days v1.0 - By Chris Tracyπ' Credit goes to the person who originally wrote this routine in GWBASIC...π' This routine can be used to find the number of days between ANY date.π' It accounts for leap years, leap centuries, etc.π π' M1/D1/Y1 - The First Date (Ie. 1/1/85)π' M2/D2/Y2 - The Last Date (Ie. 1/3/93)π' N        - The Value Returned.π π' See the main module of an example of how to use this routine.πCheckVariables:π        IF M1 > 12 THEN GOTO EndTheSub:π        IF D1 > 31 THEN GOTO EndTheSub:πMainBody:π        Y = Y1π        M = M1π        D = D1π        GOSUB FindDays:π        N = Aπ        Y = Y2π        D = D2π        M = M2π        GOSUB FindDays:π        N = A - Nπ        GOTO EndTheSub:πFindDays:π        ON M GOTO Check1, Check2, Check1, Check3, Check1, Check3, Check1, Check1, Check3, Check1, Check3, Check1π        RETURNπCheck1:π        IF D > 31 THEN GOTO FindDays:π        GOTO DetermineDays:πCheck2:π        IF Y / 4 <> INT(Y / 4) THEN GOTO Check4:π        IF Y / 400 = INT(Y / 400) THEN GOTO Check5:π        IF Y / 100 <> INT(Y / 100) THEN GOTO Check5:πCheck4:π        IF D > 28 THEN GOTO Returner:πCheck5:π        IF D > 29 THEN GOTO Returner:π        GOTO DetermineDays:πCheck3:π        IF D > 30 THEN GOTO Returner:πDetermineDays:π    SELECT CASE Mπ        CASE 1π                A = 0π        CASE 2π                A = 31π        CASE 3π                A = 59π        CASE 4π                A = 90π        CASE 5π                A = 120π        CASE 6π                A = 151π        CASE 7π                A = 181π        CASE 8π                A = 212π        CASE 9π                A = 243π        CASE 10π                A = 273π        CASE 11π                A = 304π        CASE 12π                A = 334π    END SELECTπ    A = A + Y * 365 + INT(Y / 4) + D + 1 - INT(Y / 100) + INT(Y / 400)π    IF INT(Y / 4) <> Y / 4 THEN GOTO Returner:π    IF Y / 400 = INT(Y / 400) THEN GOTO Returner:π    IF Y / 100 = INT(Y / 100) THEN GOTO Returner:π    IF M > 2 THEN GOTO Returner:π    A = A - 1πReturner:π    RETURNπEndTheSub:π    END SUBπZachary Becker                 UNIVERSAL TIME ZONE FINDER     Night Owl v10 CD-ROM           Year of 1993           QB, QBasic, PDS        62   2282     UTZ.BAS     'This program will determine the current coordinated universal time (UTC)π'in any one of the 5 time zones in the United States, plus the Atlanticπ'time zone. This program will adjust for daylight savings time.πππDECLARE SUB pause ()π0 CLSπ10 PRINT "      Coordinated Universal Time Finder for the United States"π15 PRINT ""π20 PRINT "              U      U    TTTTTTTT   ZZZZZZZZZ    "π30 PRINT "              U      U       TT           ZZ"π40 PRINT "              U      U       TT         ZZ"π50 PRINT "               U    U        TT       ZZ"π60 PRINT "                UUUU         TT      ZZZZZZZZZ"π70 PRINT ""π100 PRINT "Copyright 1993 by Zachary Becker. All Rights Reserved. "π105 PRINT " Version 1.0 Use this program at your OWN RISK. No warranties"π106 PRINT "either expressed or implied are given and the author is not liable"π107 PRINT "for any damage to any property or person resulting from use of "π108 PRINT "this program. THIS VERSION (1.0) may be distributed freely, as shareware"π109 PRINT "in its ENTIRE and ORIGINAL form ONLY. DO NOT TAMPER."πpauseπ110 CLSπ120 PRINT "Do you wish to continue? (Y/N)"π130 INPUT b$π140 IF b$ = "N" OR b$ = "n" THEN GOTO 155π150 IF b$ = "Y" OR b$ = "y" THEN GOTO 160π155 PRINT "Have a nice day!"; CHR$(1)π157 ENDπ160 CLSπ170 PRINT "What is the local time right now? (Please type as a 24 hour numeral.)"π180 INPUT cπ190 CLSπ200 PRINT "What time zone are you in now?"π210 PRINT " H-Hawaii or Alaska"π220 PRINT " P-Pacific"π230 PRINT " M-Mountain"π240 PRINT " C-Central"π250 PRINT " E-Eastern"π260 PRINT " A-Atlantic"π270 INPUT d$π280 IF d$ = "H" OR d$ = "h" THEN LET e = c + 1000π290 IF d$ = "P" OR d$ = "p" THEN LET e = c + 800π300 IF d$ = "M" OR d$ = "m" THEN LET e = c + 700π310 IF d$ = "C" OR d$ = "c" THEN LET e = c + 600π320 IF d$ = "E" OR d$ = "e" THEN LET e = c + 500π330 IF d$ = "A" OR d$ = "a" THEN LET e = c + 400π340 CLSπ350 PRINT "Are you on daylight savings time now? (Y/N) "π360 INPUT f$π370 IF f$ = "N" OR f$ = "n" THEN LET e = eπ380 IF f$ = "Y" OR f$ = "y" THEN LET e = e - 100π390 CLSπ400 IF e > 2400 THEN LET e = e - 2400π440 PRINT "The correct coordinated universal time is "; e; " hours."π450 GOTO 120ππSUB pauseπFOR a = 1 TO 200000πNEXT aπEND SUBππPeter Norton                   VISUAL CLOCK DISPLAY           Advanced BASIC Book            Unknown Date           QB, QBasic, PDS        15   566      CLOCK.BAS           SCREEN 8π        DRAW "BU50 NL25 F12 D20 G12 L50 H12 U20 E12 R25 BD22"π        DOπ        TimeMark! = TIMERπ        Hours! = INT(TimeMark! / 3600)π        Remainder! = TimeMark! - 3600 * Hours!π        IF Hours! > 12 THEN Hours! = Hours! - 12π        HourAngle! = -Hours! / 12 * 360π        Minutes! = INT(Remainder! / 60)π        MinuteAngle! = -Minutes! / 60 * 360π        DRAW "TA=" + VARPTR$(HourAngle!) + " NU8"π        DRAW "TA=" + VARPTR$(MinuteAngle!) + " NU12"π        LOCATE 15, 34: PRINT TIME$π        LOOP UNTIL INKEY$ = CHR$(27)ππMatt Pritchard                 TIMER FUNCTIONS                FidoNet QUIK_BAS Echo          09-30-92 (09:42)       QB, QBasic, PDS        39   1091     TIMERS.BAS  '>Start! = TIMER   'Start! had to be a single so it can handle the maπ'> 'amount that timer returns (86400) and so it can saveπ'>                 ' the decimal place.πππ'>> Do the peeks directly and use an INTEGER or LONG.... It'll be a wholeπ'>> lot faster than involving floating point...ππ'>How can I do that?  I got SMALLEXE.BAS from the QB news and it had aπ'>TIMER  replacement, but after midnight, it wouldn't reset to 0!π'> And it hardley ever  returned the same thing as TIMER (itπ'>started out at 4 million whenever I ran  the program!)!ππYou can do this:ππ        DEF SEG = 0π        TimerLo% = PEEK (&h046C)ππ        (or)ππ        TimerFull& = PEEK (&h046C) + 256& * PEEK(&h046D)ππ        or in assembly ...ππ;TIMERCOUNT - QuickBASIC 4.5 File Timer Value Returned: ;DECLAREπFUNCTION TIMERCOUNT% ;Count = TIMERCOUNT% ;ππ        PUBLIC  TIMERCOUNTππTIMERCOUNT      PROC    FARππ        XOR     AX,AX               ;Segment = 0000π        MOV     ES,AXπ        MOV     AX,ES:[046Ch]       ;Get Timer Word..ππ        RETππTIMERCOUNT      ENDPππThe ABC Programmer             NO BRAIN (LIKE HUGO) GAME      NO,BRAIN,LIKE,HUGO,GAME        Year of 1995           QB, QBasic, PDS        749  22543    NOBRAIN.BAS '===================================================π'  NOBRAIN.BAS  By William Yu (1994)   EGA Requiredπ'  Game is incomplete, please finish.π'  Like HUGO, but without the moving dweeb.π'π'  The person you are directing has been brainwashedπ'  You must find food and money in order to surviveπ'  So you must break into the store, then find theπ'  whereabouts of Mr. BumbScum who brainwashed him.π'π'  HINTS:π'     View SUB Hints if you are stuck and have noπ'     idea as to what to do next.π'===================================================ππDEFINT A-ZπDECLARE SUB ScrollUp ()πDECLARE SUB ScrollDown ()πDECLARE SUB LONE ()πDECLARE SUB LTWO ()πDECLARE SUB MBOX (Nlines%)πDECLARE SUB PAUSE (SECS!)πDECLARE SUB parseit ()πDECLARE SUB EmptyChar ()ππCONST True = 1πCONST False = 0ππDOπ    ve = ve + 1π    READ in$πLOOP UNTIL in$ = "end"πDOπ    no = no + 1π    READ in$πLOOP UNTIL in$ = "end"πDOπ    pl = pl + 1π    READ in$πLOOP UNTIL in$ = "end"ππRESTOREπDIM SHARED Verb$(ve), noun$(no), place$(pl), UserInput$, v$, n$, p$, v, n, pππFOR count = 1 TO veπ    READ Verb$(count)πNEXTπFOR count = 1 TO noπ    READ noun$(count)πNEXTπFOR count = 1 TO plπ    READ place$(count)πNEXTπππ' Declare Variablesπ' ---------------------------------------π' ve = Verbsπ' ne = Nounsπ' Count, etc. = Countersπ' UserInput$ = Command to Parseπ' True = 1  False = 0π' CMD = Command Executedπ' Location = Current Location on MAPπ' Apples = Apples Availableπ' WindowBroken = If Window has been Brokenπ' Apples.Inv = Apples in Inventoryπ' ---------------------------------------ππCLSπSCREEN 7, 0, 0, 0πLOCATION = 1πAPPLES = -1πAPPLES.INV = 0πWindowBroken = FalseπCALL LONEπPCOPY 0, 1πMBOX (7)πCOLOR 15, 0πLOCATE 6, 5: PRINT "You are  standing just  outside a"πLOCATE 7, 5: PRINT "store.  It is night, no one seems"πLOCATE 8, 5: PRINT "to be around.  You must find some"πLOCATE 9, 5: PRINT "way  to  break  into  the  store."πLOCATE 10, 5: PRINT "A large fence  blocks  my passage"πLOCATE 11, 5: PRINT "to the south."πLOCATE 12, 5: PRINT "Exits: East, West"πA$ = INPUT$(1)πPCOPY 1, 0ππTypeCommand:πLINE (-1, 194)-(320, 180), 9, BπA = 3: I = 1: CMD = 0πLOCATE 24, 1: PRINT SPACE$(40);πLOCATE 24, 1: COLOR 15: PRINT "> "; : COLOR 10: PRINT CHR$(95);πREDIM WORD$(40)πDOπ  IF A = 39 THEN LOCATE 24, A: PRINT CHR$(95); : A = A - 1: I = I - 1π  DOπ    A$ = INKEY$π  LOOP UNTIL LEN(A$) > 0π  IF A$ = CHR$(8) AND A = 3 THEN A = A - 1: I = I - 1: GOTO CNTπ  IF A$ = CHR$(13) THEN EXIT DOπ  IF A$ = CHR$(27) THEN EXIT DOπ  IF A$ = CHR$(8) AND A = 38 THEN LOCATE 24, A: PRINT "  ";π  IF A$ = CHR$(8) AND A > 3 THEN A = A - 1: I = I - 1: A$ = " ": LOCATE 24, A: PRINT CHR$(95); "  "; : A = A - 1: I = I - 1: GOTO CNTπ  IF ASC(A$) > 30 AND A >= 3 THENπ    LOCATE 24, A: COLOR 10: PRINT A$; CHR$(95); " ";π    WORD$(I) = WORD$(I - 1) + A$π  ELSEπ    A = A - 1: I = I - 1π  END IFπCNT:π  A = A + 1π  I = I + 1πLOOPπI = I - 1πv$ = "": n$ = "": p$ = "": v = 0: n = 0: p = 0πUserInput$ = LTRIM$(RTRIM$(WORD$(I)))πBackUp$ = UserInput$πIF UserInput$ = "" THEN PCOPY 0, 1: CALL MBOX(2): COLOR 15: LOCATE 6, 5: PRINT "      Don't just sit there!": LOCATE 7, 5: PRINT "        Type Something!!!": A$ = INPUT$(1): PCOPY 1, 0: GOTO TypeCommandπparseitπIF v = 11 THEN ENDπGOSUB Commandsπ'PRINT "Verb:"; v$, "Noun:"; n$π'PRINT "Verb#"; v, "Noun#"; nπ'PRINT "Place"; p, "Place"; p$πGOTO TypeCommandππCommands:π π  SELECT CASE vππ    CASE 1 TO 5, 21      ' Hit, Kick, Punch, Shake, Break, Bustπ      IF n = 1 AND LOCATION = 1 THEN         ' Shake the Treeπ        IF APPLES = -1 THEN                  ' Shake the Applesπ          LINE (260, 35)-(300, 67), 2, BFπ          LOCATE 24, 3: PRINT SPACE$(37);π          PCOPY 0, 2π          LOCATE 24, 3: PRINT BackUp$;π          CIRCLE (266, 160), 4, 12: PAINT (266, 160), 12: LINE (266, 157)-(266, 156), 0π          CIRCLE (277, 143), 4, 12: PAINT (277, 143), 12: LINE (277, 140)-(277, 139), 0π          CIRCLE (293, 162), 4, 12: PAINT (293, 162), 12: LINE (293, 159)-(293, 158), 0π          PCOPY 0, 1π          MBOX (2)π          COLOR 15π          LOCATE 6, 5: PRINT "The tree shakes violently and"π          LOCATE 7, 5: PRINT "down comes three red apples."π          APPLES = Trueπ          A$ = INPUT$(1)π          PCOPY 1, 0π          CMD = Trueπ        ELSE                  ' No Apples on treeπ          PCOPY 0, 1π          MBOX (2)π          COLOR 15π          LOCATE 6, 5: PRINT "The tree shakes some more but"π          LOCATE 7, 5: PRINT "nothing unusual happens."π          A$ = INPUT$(1)π          PCOPY 1, 0π          CMD = Trueπ        END IFπ      END IFπ        IF n = 3 AND LOCATION = 1 THENπ          PCOPY 0, 1π          MBOX (2)π          COLOR 15π          LOCATE 6, 5: PRINT "You attempt to break the window"π          LOCATE 7, 5: PRINT "but you don't have enough force."π          A$ = INPUT$(1)π          PCOPY 1, 0π          CMD = Trueπ        END IFπ        IF n = 4 AND LOCATION = 1 THENπ          PCOPY 0, 1π          MBOX (2)π          COLOR 15π          LOCATE 6, 6: PRINT "The door is made of steel!"π          LOCATE 7, 6: PRINT "You can't bust that down."π          A$ = INPUT$(1)π          PCOPY 1, 0π          CMD = Trueπ        END IFπ        IF LEN(RTRIM$(BackUp$)) <= 5 AND CMD <> True THENπ          PCOPY 0, 1π          MBOX (1)π          COLOR 15: LOCATE 6, 16: PRINT UCASE$(v$); " what?"π          A$ = INPUT$(1)π          PCOPY 1, 0π          CMD = Trueπ        END IFπ        IF CMD <> True THENπ          PCOPY 0, 1π          MBOX (1)π          COLOR 15: LOCATE 6, 10: PRINT "Stop being so voilent!"π          A$ = INPUT$(1)π          PCOPY 1, 0π          CMD = Trueπ        END IFππ    CASE 10π      IF n = 6 AND LOCATION = 1 OR n = 7 AND LOCATION = 1 OR n = 8 AND LOCATION = 1 THENπ        IF WindowBroken = True THENπ          PCOPY 3, 1π          CALL ScrollUpπ          CALL LTWOπ          CALL ScrollDownπ          PCOPY 0, 1π          MBOX (3)π          COLOR 15π          LOCATE 6, 5: PRINT "You enter  the store finding it"π          LOCATE 7, 5: PRINT "pitch dark.  You can hardly see"π          LOCATE 8, 5: PRINT "a single thing."π          A$ = INPUT$(1)π          PCOPY 1, 0π          CMD = Trueπ          LOCATION = 2π        ELSEπ          PCOPY 0, 1π          MBOX (1)π          COLOR 15: LOCATE 6, 8: PRINT "There's no visible way in."π          A$ = INPUT$(1)π          PCOPY 1, 0π          CMD = Trueπ        END IFπ      END IFππ    CASE 12 TO 15     ' Get, Pick, Take, Grabπ      IF n = 2 AND APPLES = False OR n = 9 AND APPLES = False THEN ' Get Apples When you already have themπ        PCOPY 0, 1π        MBOX (1)π        COLOR 15: LOCATE 6, 9: PRINT "They're in your backpack!"π        A$ = INPUT$(1)π        PCOPY 1, 0π        CMD = Trueπ      END IFππ      IF LOCATION = 1 THENπ      IF n = 2 AND APPLES = True OR n = 9 AND APPLES = True THEN ' Get Apples (on Ground)π        PCOPY 2, 0π        LOCATE 24, 3: PRINT BackUp$;π        PCOPY 0, 1π        MBOX (2)π        COLOR 15π        LOCATE 6, 5: PRINT "You pick up the apples and stuff"π        LOCATE 7, 5: PRINT "them into your backpack."π        A$ = INPUT$(1)π        PCOPY 1, 0π        APPLES = Falseπ        APPLES.INV = 3π        CMD = Trueπ      END IFπ      END IFππ      IF LOCATION = 1 THENπ      IF n = 2 AND APPLES = -1 OR n = 9 AND APPLES = -1 THEN ' Get Apples (On Tree)π        PCOPY 0, 1π        MBOX (1)π        COLOR 15: LOCATE 6, 8: PRINT "They're out of your reach."π        A$ = INPUT$(1)π        PCOPY 1, 0π        CMD = Trueπ      END IFπ      END IFπ      IF LEN(RTRIM$(BackUp$)) <= 4 AND CMD <> True THEN         ' Noun not foundπ        PCOPY 0, 1π        MBOX (1)π        COLOR 15: LOCATE 6, 17: PRINT UCASE$(v$); " what?"π        A$ = INPUT$(1)π        PCOPY 1, 0π        CMD = Trueπ      END IFπ      IF n > 0 AND CMD <> True THEN ' Noun found but not in dataπ        PCOPY 0, 1π        MBOX (1)π        COLOR 15: LOCATE 6, 9: PRINT "You can't get the "; n$; "!"π        A$ = INPUT$(1)π        PCOPY 1, 0π        CMD = Trueπ      END IFπ      IF CMD <> True THEN ' Noun found but not in dataπ        PCOPY 0, 1π        MBOX (1)π        COLOR 15: LOCATE 6, 5: PRINT "You can't get that in this game."π        A$ = INPUT$(1)π        PCOPY 1, 0π        CMD = Trueπ      END IFππ    CASE 16, 23        ' Look, Seeπ      IF n = 1 AND LOCATION = 1 THENπ        PCOPY 0, 1π        IF APPLES = -1 THEN MBOX (5) ELSE MBOX (3)π        COLOR 15π        LOCATE 6, 5: PRINT "The tree seems to be quite old."π        LOCATE 7, 5: PRINT "It doesn't look as if it has a"π        LOCATE 8, 5: PRINT "sturdy foundation either."π        IF APPLES = -1 THENπ          LOCATE 9, 5: PRINT "You notice three red apples"π          LOCATE 10, 5: PRINT "hanging from it."π        END IFπ        A$ = INPUT$(1)π        PCOPY 1, 0π        CMD = Trueπ      END IFπ      IF n > 0 AND CMD <> True AND LOCATION = 1 THENπ        PCOPY 0, 1π        MBOX (2)π        COLOR 15π        LOCATE 6, 5: PRINT "The "; n$; " looks remarkably"π        LOCATE 7, 5: PRINT "similar to a "; n$π        A$ = INPUT$(1)π        PCOPY 1, 0π        CMD = Trueπ      END IFπ      IF CMD <> True AND LOCATION = 2 THENπ        PCOPY 0, 1π        MBOX (2)π        COLOR 15π        LOCATE 6, 5: PRINT "It's too dark to see very much."π        LOCATE 7, 5: PRINT "Exits: Outside"π        A$ = INPUT$(1)π        PCOPY 1, 0π        CMD = Trueπ      END IFπ      IF CMD <> True AND LOCATION = 1 THEN      ' Survey Areaπ        PCOPY 0, 1π        L = 5π        IF APPLES = True THEN L = L + 1π        IF WindowBroken = True THEN L = L + 1π        MBOX (L)π        COLOR 15, 0π        LOCATE 6, 5: PRINT "You are  standing just  outside a"π        LOCATE 7, 5: PRINT "store.  It is night, no one seems"π        LOCATE 8, 5: PRINT "to  be  around.   A  large  fence"π        LOCATE 9, 5: PRINT "blocks my  passage to  the south."π        IF APPLES = True THEN LOCATE 10, 5: PRINT "Three apples are on the ground.": K = K + 1π        IF WindowBroken = True THEN LOCATE 10, 5: PRINT "A window has been broken."π        IF L = 6 THEN LOCATE 11, 5 ELSE LOCATE 10, 5π        PRINT "Exits: East, West";π        IF WindowBroken = True THEN PRINT ", Inside"π        A$ = INPUT$(1)π        PCOPY 1, 0π        CMD = Trueπ      END IFππ    CASE 17, 18        ' Throw, Chuckπ      IF n = 2 AND p = 1 OR n = 9 AND p = 1 THENπ        IF APPLES.INV = 0 THEN      ' Not carrying any applesπ          PCOPY 0, 1π          MBOX (2)π          COLOR 15π          LOCATE 6, 5: PRINT "You don't have any apples to"π          LOCATE 7, 5: PRINT "throw with."π          A$ = INPUT$(1)π          PCOPY 1, 0π          CMD = Trueπ        ELSE                         ' Has Apples in BackPackπ         IF WindowBroken = False THENπ          X = 20π          DOπ            PCOPY 0, 1π            CIRCLE (160, 85), X, 12: PAINT (160, 85), 12π            PAUSE (.01)π            PCOPY 1, 0π            X = X - 2π          LOOP UNTIL X = 0π          LINE (186, 75)-(182, 75), 11: LINE (186, 75)-(186, 85), 11π          LINE (140, 85)-(133, 75), 0: LINE (133, 75)-(150, 84), 0π          LINE (150, 84)-(160, 76), 0: LINE (160, 76)-(168, 80), 0π          LINE (168, 80)-(175, 74), 0: LINE (175, 74)-(185, 79), 0π          LINE (185, 79)-(180, 95), 0: LINE (180, 95)-(188, 106), 0π          LINE (188, 106)-(181, 104), 0: LINE (181, 104)-(181, 101), 0π          LINE (181, 101)-(139, 101), 0: LINE (139, 101)-(139, 104), 0π          LINE (139, 104)-(134, 108), 0: LINE (134, 108)-(132, 100), 0π          LINE (132, 100)-(140, 85), 0: PAINT (160, 80), 0π          PCOPY 0, 1π          MBOX (1)π          COLOR 15: LOCATE 6, 18: PRINT "CRASH!!!"π          PAUSE (1)π          PCOPY 1, 0π          MBOX (6)π          COLOR 15π          LOCATE 6, 5: PRINT "You take a  step back,  and with"π          LOCATE 7, 5: PRINT "the arm of Nolan Ryan, you throw"π          LOCATE 8, 5: PRINT "the  apple at  the  window  with"π          LOCATE 9, 5: PRINT "great accuracy and force that it"π          LOCATE 10, 5: PRINT "completely  shatters the window."π          LOCATE 11, 5: PRINT "Not to mention the apple."π          EmptyCharπ          A$ = INPUT$(1)π          PCOPY 1, 0π          CMD = Trueπ          WindowBroken = Trueπ         ELSEπ          PCOPY 0, 1π          MBOX (2)π          COLOR 15π          LOCATE 6, 5: PRINT "The window is already broken."π          LOCATE 7, 5: PRINT "No sense in wasting another one."π          A$ = INPUT$(1)π          PCOPY 1, 0π          CMD = Trueπ         END IFπ        END IFπ      END IFππ    CASE 19        ' Openπ      IF n = 3 AND LOCATION = 1 THENπ        PCOPY 0, 1π        MBOX (2)π        COLOR 15π        LOCATE 6, 5: PRINT "The window can't be opened from"π        LOCATE 7, 5: PRINT "the outside."π        A$ = INPUT$(1)π        PCOPY 1, 0π        CMD = Trueπ      END IFπ      IF n = 4 AND LOCATION = 1 THENπ        PCOPY 0, 1π        MBOX (4)π        COLOR 15π        LOCATE 6, 5: PRINT "If it  was only  that  easy you"π        LOCATE 7, 5: PRINT "could pass this game in no less"π        LOCATE 8, 5: PRINT "than  two  minutes!   Nice  try"π        LOCATE 9, 5: PRINT "anyways but the door is locked."π        A$ = INPUT$(1)π        PCOPY 1, 0π        CMD = Trueπ      END IFππ    CASE 20       ' Readπ      IF n = 5 AND LOCATION = 1 THEN   ' Read Signπ        PCOPY 0, 1π        MBOX (2)π        COLOR 15π        LOCATE 6, 5: PRINT "What are you, blind?!"π        LOCATE 7, 5: PRINT "The sign clearly reads "; CHR$(34);π        COLOR 12: PRINT "CLOSED"; : COLOR 15: PRINT CHR$(34)π        A$ = INPUT$(1)π        PCOPY 1, 0π        CMD = Trueπ      END IFπ      IF n > 0 AND LOCATION = 1 AND CMD <> True THENπ        PCOPY 0, 1π        MBOX (1)π        COLOR 15π        LOCATE 6, 6: PRINT "How can you read a "; n$; "?!"π        A$ = INPUT$(1)π        PCOPY 1, 0π        CMD = Trueπ      END IFπ      IF LEN(RTRIM$(BackUp$)) = 4 AND CMD <> True THENπ        PCOPY 0, 1π        MBOX (1)π        COLOR 15π        LOCATE 6, 17: PRINT "READ what?"π        A$ = INPUT$(1)π        PCOPY 1, 0π        CMD = Trueπ      END IFπ      IF CMD <> True THENπ        PCOPY 0, 1π        MBOX (1)π        COLOR 15π        LOCATE 6, 7: PRINT "Can't read that in this game."π        A$ = INPUT$(1)π        PCOPY 1, 0π        CMD = Trueπ      END IFππ    CASE 22           ' Pullπ      IF n = 10 AND LOCATION = 2 OR n = 11 AND LOCATION = 2 THENπ          PAINT (100, 10), 15, 0: PAINT (10, 100), 7, 0: PAINT (100, 150), 14, 0π          PAINT (170, 26), 10, 0π          CIRCLE (170, 30), 30, 10, .1, 3.05, 1 / 2π          CIRCLE (169, 30), 30, 0, .1, 3.05, 1 / 2π          CIRCLE (180, 29), 10, 15, .5, 1.5, 1π          CIRCLE (179, 29), 10, 15, .5, 1.4, 1π          LINE (47, 30)-(320, 145), 8, BF: LINE (166, 8)-(174, 15), 7, BFπ          LINE (160, 33)-(155, 44), 14: LINE (150, 32)-(140, 47), 14π          LINE (170, 33)-(170, 40), 14π          LINE (180, 33)-(185, 44), 14: LINE (190, 32)-(200, 47), 14π          LINE (178, 29)-(178, 55), 15π          CIRCLE (178, 56), 1, 12: PAINT (178, 56), 12π        PCOPY 0, 1π        MBOX (1)π        LOCATE 6, 5: COLOR 15: PRINT " WOW!!! AWESOME, light at last!"π        A$ = INPUT$(1)π        PCOPY 1, 0π        LIGHT = Trueπ        CMD = Trueπ      END IFπ  END SELECTππ  IF CMD <> True THEN      ' Verb not found in DATAπ    PCOPY 0, 1π    MBOX (3)π    COLOR 15π    LOCATE 6, 5: PRINT "I'm sorry but I don't know how to"π    LOCATE 7, 5: COLOR 11: PRINT LCASE$(LEFT$(BackUp$, 33))π    LOCATE 8, 5: COLOR 10: PRINT "For a list of commands type HELP"π    A$ = INPUT$(1)π    PCOPY 1, 0π  END IFπRETURNππ'---------π'Verb dataπ'---------πDATA shake,hit,break,kick,punch,knock,read,climb,look,goπDATA quit,get,grab,pick,take,look,throw,chuck,open,readπDATA bust,pull,seeπDATA endππ'---------π'Noun dataπ'---------πDATA tree,apples,window,door,sign,store,in,inside,fruit,cordπDATA stringπDATA endππ'-------------π'Location dataπ'-------------πDATA windowπDATA endππENDGAME:πSCREEN 0, 0, 0, 0: WIDTH 80, 25: COLOR 7, 0: CLSπENDππSUB EmptyCharππDOπLOOP UNTIL INKEY$ = ""ππEND SUBππSUB Hintsππ' HINTS (Type as shown):π' π'     HIT TREEπ'     GET APPLESπ'     THROW APPLE AT WINDOWπ'     GO INπ'     PULL CORDπ'     QUITππEND SUBππDEFSNG A-ZπSUB LONEπDIM SIGN(120)πPALETTE 15, 0πLOCATE 1, 1: PRINT "CONVIENCE STORE"πGET (0, 0)-(118, 7), SIGNπLOCATE 1, 1: PRINT SPACE$(40)πPALETTE 15, 15πLINE (0, 177)-(319, 125), 10, BFπLINE (0, 0)-(319, 120), 1, BFπLINE (0, 120)-(319, 125), 2, BFπCIRCLE (300, 10), 16, 14πPAINT (300, 10), 14πDOπ  RANDOMIZE TIMERπ  A = INT(RND * 319) + 1π  B = INT((176 - 125 + 1) * RND + 125)π  LINE (A - 100, B)-(A + A, B + 1), 2, Bπ  LINE (A - 100, B - 120)-(A + A, B - 121), 9, Bπ  C = C + 1πLOOP UNTIL C = 60πLINE (20, 130)-(220, 60), 14, BFπLINE (10, 60)-(230, 59), 6, BFπLINE (11, 59)-(30, 35), 6πLINE (229, 59)-(210, 35), 6πLINE (210, 35)-(30, 35), 6πPAINT (100, 45), 6πPUT (57, 50), SIGN, ORπLINE (35, 130)-(72, 70), 0, BπLINE (73, 130)-(110, 70), 0, BπPAINT (40, 120), 12, 0: PAINT (100, 80), 12, 0πLINE (35, 131)-(15, 177), 8πLINE (110, 131)-(130, 177), 8πLINE (35, 131)-(110, 131), 8πLINE (130, 177)-(15, 177), 8πPAINT (80, 150), 7, 8πLINE (130, 177)-(15, 177), 7πLINE (69, 97)-(67, 103), 7, BFπLINE (76, 97)-(78, 103), 7, BFπLINE (130, 72)-(190, 110), 0, BπLINE (131, 73)-(189, 109), 11, BFπLINE (186, 75)-(182, 75), 15πLINE (186, 75)-(186, 85), 15πLINE (134, 107)-(134, 105), 15πLINE (134, 107)-(135, 107), 15πLINE (140, 109)-(180, 102), 12, BFπCIRCLE (145, 106), 3, 15, 1.7, 4.6πLINE (148, 104)-(148, 108), 15: LINE (148, 108)-(151, 108), 15πCIRCLE (156, 106), 2, 15πLINE (161, 104)-(164, 104), 15πLINE (160, 104)-(160, 106), 15: LINE (161, 106)-(164, 106), 15πLINE (163, 108)-(160, 108), 15: LINE (164, 108)-(164, 107), 15πLINE (167, 104)-(167, 108), 15: LINE (167, 104)-(170, 104), 15πLINE (167, 108)-(170, 108), 15: LINE (167, 106)-(169, 106), 15πLINE (173, 104)-(173, 108), 15: CIRCLE (174, 106), 3, 15, 4.7, 1.5ππLINE (290, 133)-(270, 60), 6, BFπLINE (286, 66)-(285, 126), 8: LINE (281, 77)-(279, 110), 8πLINE (290, 133)-(310, 140), 6: LINE (270, 133)-(250, 140), 6πLINE (310, 140)-(280, 135), 6: LINE (280, 135)-(250, 140), 6πPAINT (277, 134), 6πCIRCLE (260, 56), 25, 2: PAINT (260, 50), 2πCIRCLE (280, 45), 33, 2: PAINT (290, 45), 2πCIRCLE (303, 53), 22, 2: PAINT (315, 53), 2ππ'Draw ApplesπCIRCLE (266, 60), 4, 12: PAINT (266, 60), 12: LINE (266, 57)-(266, 56), 0πCIRCLE (277, 43), 4, 12: PAINT (277, 43), 12: LINE (277, 40)-(277, 39), 0πCIRCLE (293, 62), 4, 12: PAINT (293, 62), 12: LINE (293, 59)-(293, 58), 0πππEND SUBππSUB LTWOπLINE (0, 0)-(320, 178), 0, BFπLINE (47, 30)-(319, 145), 8, BπLINE (45, 30)-(45, 145), 8πLINE (45, 29)-(0, 0), 8πLINE (47, 28)-(320, 28), 8πLINE (47, 28)-(4, 0), 8πLINE (3, 0)-(320, 0), 8πLINE (319, 0)-(319, 28), 8πLINE (0, 0)-(0, 177), 8πLINE (0, 177)-(45, 146), 8πLINE (47, 147)-(320, 147), 8πLINE (47, 147)-(3, 177), 8πLINE (3, 177)-(320, 177), 8πLINE (319, 177)-(319, 147), 8πPAINT (100, 10), 7, 8: PAINT (10, 100), 8: PAINT (100, 150), 6, 8πLINE (165, 7)-(175, 15), 0, BπLINE (166, 8)-(174, 15), 8, BFπCIRCLE (170, 30), 30, 8, .1, 3.05, 1 / 2πCIRCLE (169, 30), 30, 8, .1, 3.05, 1 / 2πPAINT (170, 26), 2, 8πCIRCLE (170, 30), 30, 0, .1, 3.05, 1 / 2πCIRCLE (169, 30), 30, 0, .1, 3.05, 1 / 2πCIRCLE (180, 29), 10, 7, .5, 1.5, 1πCIRCLE (179, 29), 10, 7, .5, 1.4, 1πLINE (178, 28)-(178, 55), 7πCIRCLE (178, 56), 1, 4: PAINT (178, 56), 4ππEND SUBππSUB MBOX (Nlines%)πIF Nlines% > 3 THEN n = 10 * Nlines% - Nlines% ELSE n = 10 * Nlines%πIF Nlines% = 1 THEN n = 12πLINE (23, 37)-(300, 37 + n), 7, BπLINE (24, 38)-(299, 36 + n), 0, BFπLINE (26, 38 + n)-(301, 39 + n), 8, BFπLINE (301, 40)-(302, 39 + n), 8, BFπEND SUBππDEFINT A-ZπSUB parseitπUserInput$ = LCASE$(UserInput$) + " "π'--------------π'Parse sentenceπ'-----------------------------π'The first 3 letters of a verbπ'and the first 4 letters of aπ'noun is all that is needed.π'-----------------------------πDO WHILE LEN(UserInput$)π  FOR ve = 1 TO LEN(UserInput$)π    Char$ = MID$(UserInput$, ve, 1)π    IF Char$ = " " OR Char$ = "!" OR Char$ = "." OR Char$ = "," + "" THENπ        VrbHold$ = LEFT$(UserInput$, ve - 1)π        UserInput$ = MID$(UserInput$, ve + 1)π        Count1 = 1π        Count2 = 1π        Count3 = 1ππ        DO  'get verbπ        IF LEFT$(VrbHold$, 5) = LEFT$(Verb$(Count1), 5) THENπ            v$ = Verb$(Count1)π            v = Count1π            ve = 1π        END IFπ        Count1 = Count1 + 1π        IF Verb$(Count1) = "end" THEN EXIT DOπ        LOOPππ        IF n = 0 THENπ        DO  'get nounπ            IF LEFT$(VrbHold$, 4) = LEFT$(noun$(Count2), 4) THENπ                n$ = noun$(Count2)π                n = Count2π                ve = 1π                EXIT DOπ            END IFπ            Count2 = Count2 + 1π            IF noun$(Count2) = "end" THEN EXIT DOπ        LOOPπ        END IFππ        IF n > 0 THENπ        DO  'get locationπ            IF LEFT$(VrbHold$, 4) = LEFT$(place$(Count3), 4) THENπ                p$ = place$(Count3)π                p = Count3π                EXIT SUBπ            END IFπ            Count3 = Count3 + 1π            IF place$(Count3) = "end" THEN EXIT DOπ        LOOPπ        END IFπ    END IFπ  NEXTπLOOPπEND SUBππDEFSNG A-ZπSUB PAUSE (SECS!)πBEGIN! = TIMERπDOπLOOP UNTIL TIMER - BEGIN! > SECS!πEND SUBππDEFINT A-ZπSUB ScrollDownπFOR I% = 8240 TO 0 STEP -80πM% = FIX(I% / 256): L% = I% - (M% * 256)πOUT &H3D4, 12: OUT &H3D5, M%: OUT &H3D4, 13: OUT &H3D5, L%πWAIT &H3DA, 8: 'waits for vertical retraceπFOR DELAY = 0 TO 100: NEXT: 'Adjust for different scroll speedπNEXTπEND SUBππSUB ScrollUpπFOR I% = 0 TO 8240 STEP 80πREM M% stands for MSB and L%=LSBπM% = FIX(I% / 256): L% = I% - (M% * 256)πOUT &H3D4, 12: OUT &H3D5, M%: OUT &H3D4, 13: OUT &H3D5, L%πWAIT &H3DA, 8 'Wait for vertical retraceπFOR D = 0 TO 100: NEXT: 'Adjust for different scroll speedπNEXTπEND SUBππThe ABC Programmer             SPEED RACER DEMO               SPEED,RACER,DEMO               06-05-95 (00:00)       QB, QBasic, PDS        62   1953     SPDRACE.BAS '=======================================π'  Speed Racer Demo by William Yuπ' Simple demonstration of a verticalπ' scrolling road with a cheap imitationπ' of a race car done in QuikDrawπ'=======================================πDEFINT A-ZπSCREEN 7πREDIM Sprite%(240)π'πFOR a = 0 TO 158: READ Sprite%(a): NEXTπ'πDATA 22,25,224,-8164,7168,-25,1948,-32513,224,-8164πDATA 7168,-17,4060,-16129,224,-8164,7168,-1,8188,-7937πDATA 224,-8164,7168,-1,8188,-7937,30944,-8164,7288,-1πDATA 8188,-7937,31968,-8164,7292,-1025,8188,-7937,-288,-8164πDATA 7422,-4609,8188,-7937,-512,0,254,-2785,8160,-7937πDATA -512,0,254,-2753,16368,-3841,-512,0,254,-641πDATA 32760,-1793,-512,0,254,-641,32760,-1793,-512,0πDATA 254,-17025,32760,-1793,-512,0,254,-17025,32760,-1793πDATA -512,0,254,-8833,32760,-1793,31744,0,124,-1153πDATA 32760,-1793,14336,0,56,-14465,32760,-1793,0,0πDATA 0,-129,32760,-1793,0,0,0,-193,16368,-3841πDATA 0,0,0,-225,8160,-7937,224,-8164,7168,-1πDATA 8188,-7937,192,-16372,3072,-1,16380,-3841,192,-16372πDATA 3072,-1,16380,-3841,248,-1924,31744,-5,892,255πDATA 248,-1924,31744,248,124,0,248,-1924,31744,248πDATA 124,0,0,0,0,0,0,0,0ππPUT (100, 100), Sprite%, PSETπGET (98, 98)-(123, 126), Sprite%πLINE (98, 98)-(123, 126), 0, BFππX = 200: Y = 0: Z = 0: N = 1: M = 165: R = 230πUP = 0πDOπDOπ  IF N > 0 THEN LINE (X, Y - N)-(X + 4, Y), 0, BFπ  LINE (X, Y)-(X + 4, Y + 15), 15, BFπ  Y = Y + 25πLOOP UNTIL Y >= 225π  PUT (R, M), Sprite%, PSETπ  PUT (R + 1, M), Sprite%, PSETπ  PUT (R, M), Sprite%, PSETπV$ = INKEY$πIF V$ = CHR$(0) + "H" THENπ  IF N = 0 THEN N = 1π  UP = 1π  M = M - 1πEND IFπIF V$ = CHR$(0) + "P" THEN N = N - 1πIF V$ = CHR$(0) + "M" THEN R = R + 1πIF V$ = CHR$(0) + "K" THEN R = R - 1πIF N < 0 THEN N = 0πIF UP = 1 THEN Z = Z + NπIF M = 30 THEN M = M + 1: N = N + 1πIF N = 6 THEN N = N - 1πIF V$ = "+" AND N < 5 THEN N = N + 1πIF Z >= 15 THEN Z = -10πY = ZπLOOP UNTIL V$ = CHR$(27)ππUnknown Author(s)              FLOPPY DRIVE FUNCTIONS         FidoNet QUIK_BAS Echo          Unknown Date           QB, PDS                80   2202     FLOPPY.BAS  ' Function FLOPPYDRIVEREADY checks if disk is in driveπ' Function FLOPPYWRITEOK checks if disk is write protectedππ'$INCLUDE: 'QB.BI'ππDECLARE FUNCTION FloppyDriveReady% (Drive$, ErrCode%)πDECLARE FUNCTION FloppyWriteOK% (Drive$)ππDIM SHARED Register AS RegType, XRegister AS RegTypeXππA = FloppyDriveReady%("A", ErrCode%)ππIF ErrCode% = -1 THEN PRINT "Disk in drive." ELSE PRINT "Drive not ready."ππFUNCTION FloppyDriveReady% (Drive$, ErrCode%)π'returns True (-1) if the floppy drive specified in Drive$π'has a disk in it. If the function returns False (0), ErrCode%π'contains the DOS error code.π'by Douglas H. Lusher, April, 1993ππDrive% = (ASC(Drive$) OR 32) - 97ππ'reset floppy driveπRegister.ax = 0πRegister.dx = Drive%πCALL INTERRUPT(&H13, Register, Register)ππRegister.ax = &H401πRegister.cx = &H101πRegister.dx = Drive%πCALL INTERRUPT(&H13, Register, Register)ππ'call the interrupt twice since if a disk has just been inserted,π'the first time gives a wrong answerπRegister.ax = &H401πRegister.cx = &H101πRegister.dx = Drive%πCALL INTERRUPT(&H13, Register, Register)πFloppyDriveReady% = ((Register.flags AND 1) = 0)πErrCode% = ((Register.ax AND &HFF00) \ &H100) AND &HFFππEND FUNCTIONππFUNCTION FloppyWriteOK% (Drive$)π'returns True (-1) if the disk in the specified floppy driveπ'is not write protectedπ'by Douglas H. Lusher, April 1993ππDrive% = (ASC(Drive$) OR 32) - 97ππ'reset floppy driveπXRegister.ax = 0πXRegister.dx = Drive%πCALL INTERRUPTX(&H13, XRegister, XRegister)πXRegister.ax = &H401πXRegister.cx = &H101πXRegister.dx = Drive%πCALL INTERRUPTX(&H13, XRegister, XRegister)ππBuffer$ = SPACE$(512)π'read from the diskπXRegister.ax = &H201πXRegister.es = VARSEG(Buffer$)πXRegister.bx = SADD(Buffer$)πXRegister.cx = &H101πXRegister.dx = Drive%πCALL INTERRUPTX(&H13, XRegister, XRegister)ππ'try writing back to the diskπXRegister.ax = &H301πXRegister.es = VARSEG(Buffer$)πXRegister.bx = SADD(Buffer$)πXRegister.cx = &H101πXRegister.dx = Drive%πCALL INTERRUPTX(&H13, XRegister, XRegister)πFloppyWriteOK% = ((XRegister.flags AND 1) = 0)πErrCode% = ((XRegister.ax AND &HFF00) \ &H100) AND &HFFππEND FUNCTIONππDave Navarro, Jr.              DISABLE/ENABLE DRIVE           [e-mail]            Unknown Date           PB                     25   427      DRVONOFF.BAS'Disables/Enables the specified drive.  DOS 5+ ONLY.π'Drive = (0 = A:, 1 = B:, etc.)π'π'Public Domain source by Dave Navarro, Jr.πππSUB DisableDrive(BYVAL Drive AS INTEGER) PUBLICππ  ! push DSπ  ! mov  DX, Driveπ  ! mov  AX, &H5F08π  ! int  &H21π  ! pop  DSππEND SUBππSUB EnableDrive(BYVAL Drive AS INTEGER) PUBLICππ  ! push DSπ  ! mov  DX, Driveπ  ! mov  AX, &H5F07π  ! int  &H21π  ! pop  DSππEND SUBπBrian McLaughlin               DETECT IF DRIVE IS READY       [e-mail]            Unknown Date           PB                     64   1570     DRVREADY.BAS' Drive Ready source for PowerBASIC 3.xπ' by BRIAN MCLAUGHLINππ$LIB ALL OFFππDEFINT A-ZππDECLARE FUNCTION DriveReady( BYVAL Drive$ )ππFOR X = ASC( "A" ) TO ASC( "F" )π  PRINT "Checking...";π  Ready = DriveReady( CHR$( X ))π  PRINT "drive "; CHR$( X );π  IF Ready THENπ    PRINT " ready."π  ELSEπ    PRINT " NOT ready."π  END IFπNEXTππ'===============================πFUNCTION DriveReady( BYVAL Drive$ ) PUBLIC AS INTEGERπ'===============================π' This FUNCTION returns -1 (true) if the drive is ready, or 0 (false),π' if the drive is not ready, or the drive letter is an invalid drive.π' It will NOT recognize a CD-ROM drive as being ready.ππ  DIM DriveNum AS LOCAL INTEGERπ  DIM DriveIsReady AS LOCAL INTEGERππ  DriveNum = ( ASC( Drive$ ) OR 32 ) - 97π  DriveIsReady = -1 'assume drive will be readyππ  ! push DSπ  ! xor  AX, AXπ  ! mov  DX, DriveNum     ; zero - based drive numbering usedπ  ! int  &H13             ; CALL BIOS TO RESET the drive controllerπ  ! mov  AX, &H401π  ! mov  CX, &H101π  ! mov  DX, DriveNumπ  ! int  &H13π  ! mov  AX, &H401π  ! mov  CX, &H101π  ! mov  DX, DriveNumπ  ! int  &H13π  ! jnc  DriveOK          ; carry set could be a fixed diskπ  ! mov  AH, &H1C         ; so LET us look, USING DOSπ  ! mov  DX, DriveNumπ  ! inc  DX               ; one - based drive numbering usedπ  ! int  &H21π  ! cmp  DX, &HFFπ  ! je   DriveOKπ  ! mov  AX, [BX]π  ! cmp  AX, &HF8π  ! je   DriveOKπ  ! mov  DriveIsReady, 0ππDriveOK:ππ  ! pop DSππ  DriveReady = DriveIsReadyππEND FUNCTIONπJames Vahn                     CMOS SAVE/RESTORE UTILITY      FidoNet QUIK_BAS Echo          Unknown Date           QB, QBasic, PDS        28   746      CMOS.BAS    'cmos2dsk.bas - James Vahnπ'CMOS save/restore utilityπ πDIM Byte AS STRING * 1πLOCATE , , 1πPRINT "Cmos 2 disk - James Vahn 1:30854/20@fidonet"πPRINT "Would you like to (S)ave or (R)estore your current CMOS data? ";π πWHILE a$ = "": a$ = INKEY$: WENDπIF a$ = "s" THENπ        OPEN "\cmos.dat" FOR OUTPUT AS #1π        FOR CMOS = &H0 TO &H3Fπ        OUT &H70, CMOSπ        DByte% = INP(&H71)π        PRINT #1, CHR$(DByte%);π        NEXT: CLOSE 1πPRINT "Data Saved": ENDπ πELSEIF a$ = "r" THENπ        OPEN "\cmos.dat" FOR BINARY AS #1π        FOR CMOS = 1 TO LOF(1)π        OUT &H70, CMOS - 1π        GET #1, , Byteπ        OUT &H71, ASC(Byte)π        NEXT: CLOSE 1πPRINT "Data Restored - please reboot.": ENDπ πEND IFπFrancois Roy                   CD-ROM RECOGNITION             FidoNet QUIK_BAS Echo          02-10-93 (17:19)       QB, PDS                53   1811     RECDROM.BAS 'You can use CALL INTERRUPT to read the ISO-9660 sectors via MSCDEX.  The VTOCπ'(Volume Table of Contents) is accessible as shown below; I don't have itsπ'structure so can't tell you what the fields mean, but I can betcha no two areπ'alike... the VTOC is a 2048-byte string; I defined my buffer in CDVTOC with aπ'length of 4096 because for some reason 2048 gives me String Space Corruptπ'errors... the demo routine below prints the first 800 bytes of the VTOC butπ'you may want to store the whole 2048 bytes as the CD's "fingerprint".π π'The code snippet below is for QB; QBX far strings need a small alteration.π πDECLARE SUB CDVTOC (D$, V$)πDECLARE SUB CDDRIVE (DR$)π   TYPE REGTYPE  ' For CALL INTERRUPTπ     AX AS INTEGERπ     BX AS INTEGERπ     CX AS INTEGERπ     DX AS INTEGERπ     BP AS INTEGERπ     SI AS INTEGERπ     DI AS INTEGERπ     FL AS INTEGERπ     DS AS INTEGERπ     ES AS INTEGERπ   END TYPEπ   DIM SHARED INR AS REGTYPE, OUR AS REGTYPEπ   CALL CDDRIVE(D$)π   PRINT "Drive:"; D$π   CALL CDVTOC(D$, V$)π   PRINT LEFT$(V$, 800)π   ENDπ πSUB CDDRIVE (DR$) STATICπ    DR$ = STRING$(32, 0)π    INR.AX = &H150Dπ    INR.BX = SADD(DR$)π    INR.ES = SSEG(DR$)π    CALL InterruptX(&H2F, INR, OUR)π    IF ASC(DR$) = 0 THEN DR$ = "" ELSE DR$ = CHR$(ASC(DR$) + 65) + ":"πEND SUBπ πSUB CDVTOC (D$, V$) STATICπREM Reads VTOCπ    DR$ = STRING$(4096, 0)π    INR.AX = &H1505π    INR.BX = SADD(DR$)π    INR.CX = INSTR("ABCDEFGHIJKLMNOP", LEFT$(D$, 1)) - 1π    INR.DX = 0  ' 1st volume descriptorπ    INR.ES = SSEG(DR$)π    CALL InterruptX(&H2F, INR, OUR)πREM AX=1 is normal and indicates a standard vol. descr.πREM AX=15 is 'Invalid Drive' and 21 is 'Not Ready'. 255 means no vol. desc.π    IF OUR.AX > 1 THEN V$ = "Error" + STR$(OUR.AX) ELSE V$ = DR$πEND SUBπDave Navarro, Jr.              REPORTS DISK INFORMATION       Christy Gemmell                06-20-95 (00:00)       PB                     43   1905     DISKID.BAS  ' DISKID.BAS    reports disk volume and serial number from boot sectorπ'π'   Author:     Christy Gemmell ([e-mail])π'   Date:       12/4/1992π'π' Captured from alt.lang.basic newsgroup on July 20, 1995 and convertedπ' to PowerBASIC by Dave Navarro, Jr. ([e-mail])ππ    TYPE ParaBlockπ        Info  AS INTEGER                ' Call information levelπ        SerNo AS LONG                   ' Disk serial numberπ        Label AS STRING * 11            ' Volume labelπ        FlSys AS STRING * 8             ' File system typeπ    END TYPEππ    INPUT "Which drive - <Enter> for default"; D$ππ    GetDiskID D$, S$, V$, F$π    PRINTπ    PRINT "Disk information for drive "; D$π    PRINT "----------------------------"π    PRINT "Volume label  : "; V$π    PRINT "Serial number : "; S$π    PRINT "File system   : "; F$πENDππSUB GetDiskID (Drive$, Serial$, Volume$, FileSys$)π    DIM Para AS ParaBlock               ' Buffer for drive parameter blockπ    Para.Info = 0                       ' Information level always zeroπ    REG 1, &H440D                       ' Generic IOCTL device requestπ    IF Drive$ = "" THEN                 ' If no drive specifiedπ       REG 2, 0                         '    then use defaultπ    ELSE                                ' Otherwise convertπ       REG 2, ASC(UCASE$(Drive$)) - 64  ' drive letter to numberπ    END IF                              '     A: = 1, B: = 2 etcπ    REG 3, &H866                        ' Subfunction: get drive IDπ    REG 8, VARSEG(Para)                 ' Segment of bufferπ    REG 4, VARPTR(para)                 ' Offset of bufferπ    CALL INTERRUPT &H21                 ' Invoke DOSπ    Serial$ = HEX$(Para.SerNo)          ' Get serial numberπ    Volume$ = Para.Label                ' Get volume labelπ    FileSy$ = Para.FlSys                ' Get file system typeπEND SUBπChristy Gemmell                GET/SET FILES DATE/TIME        GET,SET,FILE,DATE,TIME         07-10-95 (00:00)       QB, PDS                205  7972     QBFDATE.BAS ' FILEDATE.BAS  get and set a files date and time stamps.π'π'   Author:     Christy Gemmellπ'   Date:       10/7/1995π'   Language:   QuickBASICπ'π'   $INCLUDE: 'QB.BI'π'π    DECLARE FUNCTION GetDateFormat% ()π    DECLARE FUNCTION GetFileDate$ (FileName$)π    DECLARE FUNCTION Sint% (Num&)π    DECLARE FUNCTION UInt& (Num%)π    DECLARE SUB SetFileDate (FileName$, FileDate$, Fmt%, Done%)ππ    DIM SHARED Regs AS RegTypeXππ    CLS : PRINT : FileName$ = "QB.EXE"π    OldDate$ = GetFileDate$(FileName$)π    IF OldDate$ <> "" THENπ       PRINT FileName$; " is currently dated "; OldDate$π       PRINTπ       NewDate$ = LEFT$(DATE$, 6) + MID$(DATE$, 9, 2) + "  " + TIME$π       PRINT "Setting file to current date and time... ";π       SetFileDate FileName$, NewDate$, 0, Done%π       IF Done% THENπ          PRINT "done"π          NewDate$ = GetFileDate$(FileName$)π          PRINTπ          PRINT FileName$; " is now dated "; NewDate$π          PRINTπ          PRINT "Now reverting back to previous setting... ";π          SetFileDate FileName$, OldDate$, -1, Done%π          IF Done% THENπ             PRINT "done"π             DateNow$ = GetFileDate$(FileName$)π             PRINTπ             PRINT FileName$; " is now dated "; DateNow$π          ELSEπ             PRINT "failed!"π          END IFπ       ELSEπ          PRINT "failed!"π       END IFπ    END IFπENDππ'Thanks to Derek Sim who gave me algorithms for inserting and extractingπ'the years, months, days, hours, minutes and seconds from the encodedπ'bits of the various registers. It made me wish that Microsoft had givenπ'us a SHIFT statement like PowerBASIC.ππ'   Returns a code indicating the national date format.π'π'   Return values:  0 = MM-DD-YY   (USA)π'                   1 = DD/MM/YY   (Europe)π'                   2 = YY-MM-DD   (Japan)π'π'   Depends on COUNTRY = setting in CONFIG.SYS (default = USA)π'πFUNCTION GetDateFormat%π    B$ = SPACE$(64)                     ' To hold country informationπ    Regs.ds = VARSEG(B$)                ' DS = segment of bufferπ    Regs.dx = SADD(B$)                  ' DX = offset of bufferπ    Regs.ax = &H3800                    ' DOS Service 56π    INTERRUPTX &H21, Regs, Regs         ' - get country informationπ    GetDateFormat% = ASC(B$)            ' Date format is first byteπEND FUNCTIONππ'   Returns date and time a file was last updated.π'π'   The date and time are returned as a string in one of these formats:π'π'       --123456789012345678--π'π'         MM-DD-YY  HH:MM:SS    (for USA)π'         DD/MM/YY  HH:MM:SS    (for Europe)π'         YY-MM-DD  HH:MM:SS    (for Japan)π'π'   (there are two blank spaces between the date and timeπ'πFUNCTION GetFileDate$ (FileName$)π    Dt$ = ""                            ' Assume failureπ    F$ = FileName$ + CHR$(0)            ' Make filespec ASCIIZπ    Regs.ds = VARSEG(F$)                ' DS = segment of filespecπ    Regs.dx = SADD(F$)                  ' DX = offset of filespecπ    Regs.ax = &H3D00                    ' DOS Service 61π    INTERRUPTX &H21, Regs, Regs         ' - open file for readingπ    Carry% = Regs.flags AND 1           ' Check carry flagπ    IF Carry% = 0 THEN                  ' If no error occurred..π       Handle% = Regs.ax                ' Get handle from AXπ       Regs.bx = Handle%                ' Transfer it to BXπ       Regs.ax = &H5700                 ' DOS Service 87π       INTERRUPTX &H21, Regs, Regs      ' - get file date and timeπ       Carry% = Regs.flags AND 1        ' Check carry flagπ       IF Carry% = 0 THEN               ' If no error occurred..π          FlTime& = UInt&(Regs.cx)      ' Bit-encoded time from CXπ          FlDate& = UInt&(Regs.dx)      ' Bit-encoded date from DXπ          Yr% = (FlDate& \ 512) + 1980  ' Get yearπ          FlDate& = FlDate& AND &H1FF   ' Isolate day and monthπ          Mth% = FlDate& \ 32           ' Get monthπ          Day% = FlDate& AND &H1F       ' Get dayπ          Hrs% = FlTime& \ 2048         ' Get hoursπ          FlTime& = FlTime& AND &H7FF   ' Isolate minutes and secondsπ          Mins% = FlTime& \ 32          ' Get hoursπ          Sex% = (FlTime& AND &H1F) * 2 ' Get secondsπ          Y$ = RIGHT$("0" + LTRIM$(RTRIM$(STR$(Yr%))), 2)π          M$ = RIGHT$("0" + LTRIM$(RTRIM$(STR$(Mth%))), 2)π          D$ = RIGHT$("0" + LTRIM$(RTRIM$(STR$(Day%))), 2)π          Fmt% = GetDateFormat%         ' Get national date formatπ          SELECT CASE Fmt%π              CASE 0                    ' USAπ                   Dt$ = M$ + "-" + D$ + "-" + Y$π              CASE 1                    ' Europeπ                   Dt$ = D$ + "/" + M$ + "/" + Y$π              CASE 2                    ' Japanπ                   Dt$ = Y$ + "-" + M$ + "-" + D$π              CASE ELSEπ          END SELECTπ          H$ = RIGHT$("0" + LTRIM$(RTRIM$(STR$(Hrs%))), 2)π          M$ = RIGHT$("0" + LTRIM$(RTRIM$(STR$(Mins%))), 2)π          S$ = RIGHT$("0" + LTRIM$(RTRIM$(STR$(Sex%))), 2)π          Dt$ = Dt$ + "  " + H$ + ":" + M$ + ":" + S$π       END IFπ       Regs.bx = Handle%                ' File handle to BXπ       Regs.ax = &H3E00                 ' DOS Service 62π       INTERRUPTX &H21, Regs, Regs      ' - close the fileπ    END IFπ    GetFileDate$ = Dt$                  ' Return date and time as stringπEND FUNCTIONππ'   Sets the last-access date and time of the specified file.π'π'   Note: FileDate$ must be in one of the following formats:π'π'       --123456789012345678--π'π'         MM-DD-YY  HH:MM:SS    (for USA)π'         DD/MM/YY  HH:MM:SS    (for Europe)π'         YY-MM-DD  HH:MM:SS    (for Japan)π'π'   (there are two blank spaces between the date and timeπ'π'   If Fmt% is TRUE (non-zero) then the procedure uses the dateπ'   format for the country corresponding to the COUNTRY= settingπ'   in the computers CONFIG.SYS file (default = USA)π'π'   If Fmt% is FALSE (zero) then USA format is used.π'πSUB SetFileDate (FileName$, FileDate$, Fmt%, Done%)π    Done% = 0                           ' Assume failureπ    F$ = FileName$ + CHR$(0)            ' Make filespec ASCIIZπ    Regs.ds = VARSEG(F$)                ' DS = segment of filespecπ    Regs.dx = SADD(F$)                  ' DX = offset of filespecπ    Regs.ax = &H3D00                    ' DOS Service 61π    INTERRUPTX &H21, Regs, Regs         ' - open file for readingπ    Carry% = Regs.flags AND 1           ' Check carry flagπ    IF Carry% = 0 THEN                  ' If no error occurred..π       Handle% = Regs.ax                ' Get handle from AXπ       IF Fmt% THENπ          Fmt% = GetDateFormat%         ' Get national date formatπ       END IFπ       SELECT CASE Fmt%π           CASE 0                       ' USAπ                Day% = VAL(MID$(FileDate$, 4, 2))π                Mth% = VAL(LEFT$(FileDate$, 2))π                Yr% = VAL(MID$(FileDate$, 7, 2))π           CASE 1                       ' Europeπ                Mth% = VAL(MID$(FileDate$, 4, 2))π                Day% = VAL(LEFT$(FileDate$, 2))π                Yr% = VAL(MID$(FileDate$, 7, 2))π           CASE 2                       ' Japanπ                Mth% = VAL(MID$(FileDate$, 4, 2))π                Yr% = VAL(LEFT$(FileDate$, 2))π                Day% = VAL(MID$(FileDate$, 7, 2))π           CASE ELSEπ       END SELECTπ       Hrs% = VAL(MID$(FileDate$, 11, 2))π       Mins% = VAL(MID$(FileDate$, 14, 2))π       Sex% = VAL(MID$(FileDate$, 17, 2))π       IF Yr% < 80 THEN Yr% = Yr% + 100 ' Remember the 21st Centuryπ       FlDate& = ((Yr% - 80) * 512) + (Mth% * 32) + Day%π       Regs.dx = Sint%(FlDate&)         ' Load result into DXπ       FlTime& = (Hrs% * 2048&) + (Mins% * 32) + (Sex% \ 2)π       Regs.cx = Sint%(FlTime&)         ' Load result into CXπ       Regs.bx = Handle%                ' File handle to BXπ       Regs.ax = &H5701                 ' DOS Service 87π       INTERRUPTX &H21, Regs, Regs      ' - set file date and timeπ       Carry% = Regs.flags AND 1        ' Check carry flagπ       IF Carry% = 0 THEN               ' If no error occurred..π          Done% = -1                    '   report successπ       END IFπ       Regs.bx = Handle%                ' File handle to BXπ       Regs.ax = &H3E00                 ' DOS Service 62π       INTERRUPTX &H21, Regs, Regs      ' - close the fileπ    END IFπEND SUBππFUNCTION Sint% (Num&)π    Sint% = -((Num& > 32767) * (Num& - 65536)) - ((Num& < 32767) * Num&)πEND FUNCTIONππFUNCTION UInt& (Num%)π    UInt& = -((Num% < 0) * (65536 + Num%) + ((Num% >= 0) * Num%))πEND FUNCTIONππDave Cleary                    PDS DIR$ FUNCTION FOR QB       FidoNet QUIK_BAS Echo          Unknown Date           QB                     82   2816     DIR.BAS     'DIR.BAS by Dave Clearyπ'π'One of the most useful additions to BASIC 7 PDS is the DIR$ function.π'This function allows you to read a directory of filenames. It alsoπ'allows you to check the existence of a file by doing the following:π'π'  IF LEN(DIR$("COMMAND.COM")) THENπ'     PRINT "File Found"π'  ELSEπ'     PRINT "File not found"π'  END IFπ'π'Now QuickBASIC 4.X users can have this useful function for theirπ'programs.π'π'Calling DIR$ with a FileSpec$ returns the the name of the FIRSTπ'matching file name. Subsequent calls with a null FileSpec$ return theπ'NEXT matching file name. If a null string is returned, then no moreπ'matching files were found. FileSpec$ can contain both a drive and aπ'path plus DOS wildcards. Special care should be taken when usingπ'this on floppy drives because there is no check to see if the driveπ'is ready.ππDEFINT A-ZππDECLARE FUNCTION DIR$ (FileSpec$)ππ'$INCLUDE: 'QB.BI'ππ'-----  Some constants that DIR$ usesπCONST DOS = &H21πCONST SetDTA = &H1A00, FindFirst = &H4E00, FindNext = &H4F00ππ'--------------------------------------------------------------------π'This shows how to call DIR$ to find all matching filesππCLSπFileSpec$ = "C:\QB\*.*"πFound$ = DIR$(FileSpec$)πDO WHILE LEN(Found$)π   PRINT Found$π   Found$ = DIR$("")πLOOPππ'--------------------------------------------------------------------ππFUNCTION DIR$ (FileSpec$) STATICππ   DIM DTA AS STRING * 44, Regs AS RegTypeXπ   Null$ = CHR$(0)ππ'-----  Set up our own DTA so we don't destroy COMMAND$π   Regs.AX = SetDTA                    'Set DTA functionπ   Regs.DX = VARPTR(DTA)               'DS:DX points to our DTAπ   Regs.DS = -1                        'Use current value for DSπ   InterruptX DOS, Regs, Regs          'Do the interruptππ'-----  Check to see if this is First or Nextπ   IF LEN(FileSpec$) THEN              'FileSpec$ isn't null, soπ                                'FindFirstπ     FileSpecZ$ = FileSpec$ + Null$   'Make FileSpec$ into an ASCIIZπ                                'stringπ     Regs.AX = FindFirst              'Perform a FindFirstπ     Regs.CX = 0                      'Only look for normal filesπ     Regs.DX = SADD(FileSpecZ$)       'DS:DX points to ASCIIZ fileπ     Regs.DS = -1                     'Use current DSπ   ELSE                                'We have a null FileSpec$,π     Regs.AX = FindNext               'so FindNextπ   END IFππ   InterruptX DOS, Regs, Regs          'Do the interruptππ'-----  Return file name or nullπ   IF Regs.Flags AND 1 THEN            'No files foundπ     DIR$ = ""                        'Return null stringπ   ELSEπ     Null = INSTR(31, DTA, Null$)     'Get the filename foundπ     DIR$ = MID$(DTA, 31, Null - 30)  'It's an ASCIIZ string startingπ   END IF                              'at offset 30 of the DTAππEND FUNCTIONππLogan Ashby/Andy Thomas        CHECK IF FILE EXISTS           FidoNet QUIK_BAS Echo          Unknown Date           QB, PDS                195  6119     EXISTS.BAS  ' >    5) Procedures must be bulletproof.π' >       FUNCTION Exist - Returns true if file is present.π'π' Sounds like some interesting challenges, but it struck me asπ' odd, you want to see "bulletproof" routines, which I take toπ' mean as routines that do a lot of error-checking, yet yourπ' Exist function could be shot full of holes, to continue theπ' metaphor, fairly easily. Here's something I whipped up from myπ' own Exist function, I bulletproofed and commented it as heavilyπ' as I could. ππ DECLARE FUNCTION Exist% (seed$, SearchAttrb%)π DECLARE FUNCTION floppyDriveReady% (drive$)ππ TYPE regtype             ' Also found in QB.BIπ   ax AS INTEGERπ   bx AS INTEGERπ   cx AS INTEGERπ   dx AS INTEGERπ   bp AS INTEGERπ   si AS INTEGERπ   di AS INTEGERπ  flags AS INTEGERπ   ds AS INTEGERπ   es AS INTEGERπ END TYPEππ TYPE DTAdata                     'used by DOS servicesπ   Reserved  AS STRING * 21       'reserved for use by DOSπ   Attribute AS STRING * 1        'the file's attributeπ   FileTime  AS STRING * 2        'the file's timeπ   Filedate  AS STRING * 2        'the file's dateπ   FileSize  AS LONG              'the file's sizeπ   filename  AS STRING * 13       'the file's nameπ END TYPEππ ENDππ DEFINT A-Zπ FUNCTION Exist% (Name$, SearchAttrb%)ππ ' Format:π ' EXIST Name$, SearchAttrb%π ' Name$ can be any valid DOS filename, directory name, or volume label.π '     wildcards (* and ?) are accepted.π ' Attrb% can be the following:π '     0 == Test for any fileπ '    39 == Test for any fileπ '    16 == Test for Directory names ONLYπ '     8 == Test for Volume labels ONLYπ '     4 == Test for System files ONLYπ '     2 == Test for Hidden files ONLYπ '     1 == Test for Read-Only files ONLYπ '    63 == Test for anything file/label/directoryπ 'π '  Combinations can be made (ie. search for Read-onlyπ '  Directories) by following this binary number bit chart:π '     Bit 7  Shareable (Novell Netware, otherwise ignore)π '     Bit 6  unusedπ '     Bit 5  archiveπ '     bit 4  Directoryπ '     Bit 3  Volume Labelπ '     Bit 2  systemπ '     Bit 1  Hiddenπ '     Bit 0  Read onlyπ '  for example a Read-only Directory would be bits 0 and 4,π '  in binary numbers that's: 10001 or 17 decimal.ππ ' If the tested for item exists Exist% will be set to -1, trueπ '    and SearchAttrb% can be ignoredππ ' If the tested for item does not exist, or there is an error,π ' Exist% will be set to 0, false, and SearchAttrb% will be setπ ' to one of the following:π '    -1 == Floppy drive not ready or invalid drive letter.π '     0 == item does not exist.ππ DIM inreg AS regtype, outreg AS regtypeπ DIM DTA AS DTAdataππ seed$ = LTRIM$(RTRIM$(UCASE$(Name$)))ππ IF SearchAttrb% AND 8 THEN  ' Volume label checkπ   ' Volume Label searches need to have a "." for theπ   ' ninth character if the label is >8 characters.π   ' The following assures a correct searchππ   IF NOT (INSTR(seed$, ".")) THENππ     ' step backwards through the stringππ     FOR I = LEN(seed$) TO 1 STEP -1ππ       ' look for end of string, or drive/directory markerππ       IF MID$(seed$, I, 1) = ":" OR MID$(seed$, I, 1) = "\" OR I = 1 THENππ         ' I points to start of name, without drive/directoryπ         ' marker, see if "." is requiredππ         IF LEN(MID$(seed$, I + 1, LEN(seed$) - I)) > 8 THENππ           ' if no drive/directory, then we're checking theπ           ' default drive, in this case I must equal 0 toπ           ' place the "." correctly.ππ           IF I = 1 THEN I = 0ππ           ' place the "."ππ           seed$ = LEFT$(seed$, I) + MID$(seed$, I + 1, 8) + "." + MID$(seed$, I + 9, LEN(seed$) - I)π         END IFπ         I = 1  ' exit the next loopπ       END IFπ     NEXT Iπ   END IFπ END IFππ IF SearchAttrb% = 0 THEN SearchAttrb% = 39  ' default searchππ ' if there's a drive in the search stringπ IF INSTR(seed$, ":") THENπ   drive$ = LEFT$(seed$, 1)   ' gets the driveπ ELSEπ   drive$ = "@"               ' for default driveπ END IFππ ' if it's a floppy drive we need to make sure a diskπ ' is in the drive.π IF NOT floppyDriveReady(drive$) THENπ   SearchAttrb% = -1   ' Floppy not ready.π   Exist% = 0π   EXIT FUNCTIONπ END IFππ inreg.dx = VARPTR(DTA)      'set a new DOS DTAπ inreg.ds = VARSEG(DTA)π inreg.ax = &H1A00π CALL interruptx(&H21, inreg, outreg)ππ seed$ = seed$ + CHR$(0)     'DOS needs ASCIIZ stringπ inreg.ax = &H4E00           'find file name serviceπ inreg.cx = SearchAttrb%π inreg.dx = SADD(seed$)      'show where the spec isπ inreg.ds = VARSEG(seed$)    'use this with QB - SSEG for PDS(?)π CALL interruptx(&H21, inreg, outreg)ππ IF (outreg.flags AND 1) THENπ   SearchAttrb% = 0          ' Item does not existπ   Exist% = 0π ELSEπ   Exist% = -1               ' item existsπ END IFππ END FUNCTIONππ DEFINT A-Zπ FUNCTION floppyDriveReady% (drive$)π DIM inreg AS regtype, outreg AS regtypeππ ' This function may also be used independently fromπ ' the Exist% function. It returns -1, true if theπ ' drive is ready, or 0, false, if the drive is notπ ' ready, or the drive letter is an invalid drive.ππ drive% = (ASC(drive$) OR 32) - 97ππ 'reset floppy driveπ inreg.ax = 0π inreg.dx = drive%π CALL interruptx(&H13, inreg, outreg)ππ inreg.ax = &H401     'verify disk sectorπ inreg.cx = &H101π inreg.dx = drive%π CALL interruptx(&H13, inreg, inreg)π 'call the interrupt twice since if a disk has just beenπ 'inserted, the first time gives a wrong answerπ inreg.ax = &H401π inreg.cx = &H101π inreg.dx = drive%π CALL interruptx(&H13, inreg, outreg)ππ 'if it was a hard disk we just checked forget the whole thingπ IF outreg.ax AND 256 THENπ   inreg.ax = &H1C00      ' check drive typeπ   inreg.dx = drive% + 1  ' diff. drive number system must add 1π   CALL interruptx(&H21, inreg, outreg)π   ' check if drive was a valid drive letter.π   IF (outreg.ax AND &HFF) = &HFF THEN HardCheck = 0 ELSE HardCheck = -1π END IFππ floppyDriveReady% = ((outreg.flags AND 1) = 0) OR HardCheckππ END FUNCTIONπJ. Derek Lyons                 PARSE COMMAND LINE             QBFAQ                          11/91                  QB, PDS                222  8591     CLINE.BAS   '  Program CLINE.BASπ'  Version 1.00π'  Parses the command tail into an array holding allπ'  command line arguments.π'  Written by: J. Derek Lyons.π'  November 1991π'  Released into the public domain to the extent of my ability to do so.ππDECLARE SUB ParCline (Arg$(), MaxArg%, Res%)ππDEFINT A-ZπOPTION BASE 0ππDIM Arg$(5)             'Array to hold the argumentsπMaxArg% = 5             'Maximum number of argumentsπ'π'  To demonstrate CLINE, simply compile this program inside Quick Basicπ'  or from the command line.π'πCLSπCALL ParCline(Arg$(), MaxArg%, Res%)πFOR x = 1 TO 5: PRINT Arg$(x): NEXT xπIF Res% = -1 THEN PRINT "Too Many Arguments"πIF Res% = 0 THEN PRINT "Sucessful Processing"πIF Res% = 1 THEN PRINT "No Arguments Found"πENDππSUB ParCline (Arg$(), MaxArg%, Res%)π'  Inputsπ'     MaxArg%   Maximum number of argumentsπ'     Arg$()    Empty array to hold the argumentsπ'               To work properly should be DIMed as Arg$(MaxArg%)π'  Outputsπ'     Res%      Result of subroutineπ'               -1 = Too many argumentsπ'                0 = Sucessful processingπ'                1 = No arguments foundπ'     Arg$()    Array holding the argumentsπ'π                        'numarg and argpos must be initializedπ                        'because QB initializes them as 0πNumArg = 1              'Because there is no leading space for theπ                        'first argument we must add 1 to the totalπ                        'number of space to find the total numberπ                        'of argumentsπArgPos = 1              'The first position in the arrayππCline$ = LTRIM$(RTRIM$(COMMAND$))π                        'Get the command line and trim all the spacesπClen = LEN(Cline$)      'Get the length of the command lineππIF Clen = 0 THEN        'There are no arguments so there is no reasonπ                        'to continue processing the command lineπ   Res% = 1π   EXIT SUBπEND IFππFOR Scount = 1 TO Clen  'Get the number of argumentsπ   IF MID$(Cline$, Scount, 1) = " " THEN NumArg = NumArg + 1π                        'Each time a space is found in the command lineπ                        'the number of arguments is incrementedπNEXT ScountππIF NumArg > MaxArg% THENπ                        'So we don't crash the program by trying toπ                        'write past the end of the arrayπ   Res% = -1π   EXIT SUBπEND IFππFOR wcount = 1 TO Clenπ   IF MID$(Cline$, wcount, 1) <> " " THENπ      Arg$(ArgPos) = Arg$(ArgPos) + MID$(Cline$, wcount, 1)π                        'If a character is found, then add it to theπ                        'current stringπ   ELSEIF MID$(Cline$, wcount, 1) = " " THENπ      ArgPos = ArgPos + 1π                        'If a space is found, start processing theπ                        'next stringπ   END IFπNEXT wcountππEND SUBπ'     CLINE.BASπ'     Version 1.00π'     Mountain Bay Softwareπ'     James Derek Lyonsπ'π'     A subroutine to parse the command line forπ'     QUICK BASIC programs.ππ'CLINE.BAS is hereby released into the public domain to the extentπ'of my legal rights to do so.π'The author makes no warranty as to the fitness of this code for anyπ'given application.  The responsibility for determining fitness ofπ'use and for any damages caused lies with the user.ππ'CLINE.BAS has been tested using MSDOS V3.3 and Quick Basic V4.5.π'QUICK BASIC and MSDOS are registered trademarks of the Microsoftπ'Corporation.ππ'INDEXππ'1.      Overviewπ'2.      Program Logic.π'2A.     The Parsing Algorithmπ'3A.     Error Handling.ππ'1. OVERVIEWππ'     One of the most useful functions of MSDOS is the ability toπ'use a 'command tail'.  That is to say, a set of variables whichπ'can be read by a program at run-time and used to modify it'sπ'operation.π'     In QUICK BASIC the COMMAND$ function can be used to read theπ'command tail into your program.  However, this function returns theπ'entire command tail as a single string.  Unless you are using onlyπ'one run-time option, this is fairly useless.π'     CLINE offers the QUICK BASIC programmer a method of importingπ'this command tail and parsing it into useful string variables.ππ'2. PROGRAM LOGICππ'     The algorithm used by CLINE is fairly simple.  The requirementsπ'for using this subroutine are deliberately held to a minimum.π'     Three variables are required to use the subroutine.  Two mustπ'be declared in advance.ππ'     These variables are:π'     MaxArg%, which is the maximum number of arguments expected.π'     Arg$(),  which is a string array to hold the returned, parsed,π'              arguments.π'     Res%,    which is a variable to hold the result flag for theπ'              subroutine.ππ'     The following assumptions apply these variables;ππ'     MaxArg% is the total number of arguments that the user canπ'legally use when loading the program.  As will be shown later eachπ'argument is assumed to be separated by a space.  Thus "/FILE DUMMYπ'would be counted as two arguments.  "/FILE:DUMMY and "-AJ2" wouldπ'both be considered to be one argument.ππ'     ARG$() is a string array to hold the arguments when they areπ'parsed.  To prevent programs from bombing, ARG$() is bestπ'dimensioned by using DIM ARG$(MaxArg%).ππ'     Res% is an integer flag that returns the result of the parsingπ'process.  These results are defined as follows;ππ'     -1   indicates that too many arguments were found.  Processingπ'           is halted and control returned to the calling program.π'      0   indicates that processing was successful and the parsedπ'          arguments will be found in ARG$().π'      1   Indicates that no command line was found.  Processing isπ'          halted and control is returned to the calling program.ππ'     No error handling is performed by CLINE other than the settingπ'of Res% to the appropriate value.ππ'2A. The Parsing Algorithmππ'     The command tail retrieved by COMMAND$ is processed asπ'follows;π'     First all leading and trailing spaces are removed using theπ'LTRIM$() and RTRIM$() functions.  Since the algorithm determinesπ'the number of arguments by counting the number of spaces, anyπ'extraneous ones at the beggining and end must be removed.π'     Because there is no leading space for the first argument, theπ'NUMARG and ARGPOS() variables are initialized to 1.π'     The length of the command tail is then determined.  If no tailπ'is found, processing is returned to the calling program.  A flagπ'is set to inform the calling program that no command line optionsπ'were found.π'     Each position in the string is then examined using theπ'MIDSTRING$() function.  Each time a space is encountered, theπ'argument count is increased by one.π'     The total number of arguments found by this statement is thenπ'compared to the maximum allowable number.  If the number foundπ'exceeds the number allowed, processing is halted and controlπ'returned to the calling program.  The programmer must provide codeπ'to handle this error and inform the user of the failure.π'     Each position in the string is then examined.  If a non-spaceπ'character is encountered, the character is added to the currentπ'string.  If a space is encountered, the string number isπ'incremented by one and processing continues with the nextπ'character.ππ'     Hence the string /FILE DUMMY /A -AQD2 /OUTFILE:TEST wouldπ'parse as follows;ππ'     String #1     /FILEπ'     String #2     DUMMYπ'     String #3     /Aπ'     String #4     -AQD2π'     String #5     /OUTFILE:TESTππ'     Note that because of the way COMMAND$ functions, allπ'alphabetic characters will be in upper case.ππ'     Control is then returned to the calling program.ππ'3A. ERROR HANDLINGππ'     Other than errors relating to the number of arguments, and theπ'lack of a command tail, no native error handling is provided.ππ'     If too many arguments are encountered, the programmer mustπ'provide routines to inform the user of the syntax error and recoverπ'from the error condition.ππ'     If no arguments are provided then a flag is set to inform theπ'calling program.  The programmer must provide code for his programπ'to respond approprietly.ππ'     It is suggested that if too many, or no, command lineπ'arguments are found, that any defaults be loaded and the userπ'informed.ππ'     If this code is used in a command line utility, (a programπ'that is run only from the command line), that the program informπ'the user and exit gracefully.πBrian McLaughlin               EXPAND FILE HANDLES            FidoNet POWER_BAS Echo         10-21-95 (18:33)       PB                     78   3390     FHANDLES.BASOver the years I must have seen a couple dozen messages posted thatπwent like this:ππ"...I changed my CONFIG.SYS to read FILES=100, but BASIC will onlyπlet me open 15 files. What's wrong?..."ππHere is some PowerBASIC 3.x code to let your program open more thanπ15 files at once, and all the information you need to understand andπuse that code.ππFirst off, it isn't BASIC that is limiting your program to 15 openπfiles at once.  It's DOS.  Even though DOS lets you put a FILES=255πstatement in your CONFIG.SYS, DOS still rations out its file handlesπlike a miser giving away dollar bills.ππWhen you boot up DOS, one of the first things it does is open 5 fileπhandles for its own use, and assign them to a set of five standardπdevices, like the screen and the keyboard.  Then, when your programπstarts, DOS lets it use those 5, plus 15 more handles for its ownπfiles, for a total of 20.ππSo what good is the FILES=255, if your program only gets 20?ππIt goes like this.  Your program can get more than 20, as long as itπasks for them, nicely.  There's a DOS service, &H67, that sets theπmaximum number of file handles your program can use.  Unless youπcall &H67, you get no extra handles. Understand?ππBUT, you have to send it the number of open files you want, plus 5.πYes, that's right.  Say, you want to be able to open 30 files atπonce, not 15.  Then you must send a value of 35.  The extra five areπthe five DOS devices! DOS counts them against your limit.ππThe other catch is that, if you send it a number larger than theπFILES=XXX setting in your CONFIG.SYS, the XXX will act as a ceiling.πYou shouldn't be able to get more than XXX file handles, minus theπfive handles for DOS.ππHere's the code:ππ'------------------------- START CODE ----------------------------ππDECLARE SUB ExpandHandles (BYVAL TotalHandleCount%, ErrValue%)ππ'==============================================================π SUB ExpandHandles (BYVAL TotalHandleCount%, ErrValue%)  PUBLICπ'==============================================================π' Using this SUB, you can change the number of file handlesπ' your program can open, up to the highest number allowed under theπ'π'    FILES=XXXπ'π' statement in the CONFIG.SYS file, provided the program is runningπ' under DOS v3.3 or higher.π'π' The number you pass to this SUB should be the total number of filesπ' you want to be able to open, plus 5 (to allow for DOS stdxxx handles).π'π' If you pass a number higher than the XXX in FILES=XXX, there willπ' NOT be an error reported in ErrValue%...I don't know why DOS doesn'tπ' flag that as an error. It just doesn't!ππ  ErrValue% = 0                       ' assume no errorππ  IF TotalHandleCount% > 20 THEN      ' hey! we get 20 automatically!π    MemToFree% = (TotalHandleCount% - 20) * 2π    MEMPACK                           'pack memory firstπ    dummy& = SETMEM(-MemToFree%)      'free the memory nextπ    ASM    Mov  AH, &H67              ; DOS function 67h in AHπ    ASM    Mov  BX, TotalHandleCount% ; puts new handle total in BXπ    ASM    Int  &H21                  ; call DOS interruptπ    ASM    Jnc  NoError               ; if carry flag set, we failedπ    ASM    Mov  ErrValue%, AX         ; otherwise, return the errorπ  END IFπNoError:ππEND SUBπ'---------------------------- END CODE -----------------------------πUnknown Author(s)              TRUNCATE FILE                  FidoNet QUIK_BAS Echo          Unknown Date           QB, PDS                67   2516     TRUNC.BAS   ' > Is there an easy way in QB to truncate a file to a certain lengthπ' > without copying it? π π'Sure .. Not directly via QB, but through an interrupt call. As long asπ'the file is opened for RANDOM, BINARY or OUTPUT, this should work fine.π'I wrote it for QBX, but it'll work fine for other version by changingπ'the $INCLUDE to QB.BI for VBDOS.BI.π π    DECLARE FUNCTION TruncateFile% (Handle%, NewLength&)π    DEFINT A-Zπ    REM $INCLUDE: 'qbx.bi'π    OPEN "TEST.DAT" FOR BINARY AS #1        'Create a file to testπ    A$ = " "π    PUT #1, 10240, A$                       'Make it 10K longπ    PRINT "File length:"; LOF(1)            'Make sureπ    Handle% = FILEATTR(1, 2)                'Get DOS file handleπ    NewLength& = 5000                       'New length for this fileπ    Status% = TruncateFile%(Handle%, NewLength&)    'Do itπ    IF Status% THENπ        PRINT "DOS Error";Status%;" occurred."π    ELSEπ        PRINT "New file length:"; LOF(1)π    END IFπ    CLOSEπ πFUNCTION TruncateFile% (Handle%, NewLength&)π π    DIM Reg AS RegTypeXπ π    'First, position the file read/write pointer to the place where theπ    'truncation should take place. We can't trust BASIC's SEEK statementπ    'because the movement is sometimes held until the next read/write.π π    Reg.AX = &H4200             'DOS "Set file pointer" functionπ    Reg.BX = Handle%π π    'We go through these steps to prevent "overflow" errors whenπ    'NewLength& > 32767. The high word of the file position goes in CXπ    'and the low word goes in DX. Since BASIC treats integers and longsπ    '"signed" variables, we need to take to extra steps to preventπ    'an overflow error as we break the long integer down.π π    DEF SEGπ    Addr% = VARPTR(NewLength&)π    Reg.CX = CVI(CHR$(PEEK(Addr% + 2)) + CHR$(PEEK(Addr% + 3)))π    Reg.DX = CVI(CHR$(PEEK(Addr%)) + CHR$(PEEK(Addr% + 1)))π    CALL InterruptX(&H21, Reg, Reg)π    IF Reg.Flags AND 1 THENπ        Status% = Reg.AXπ        GOTO TruncateExitπ    END IFπ π    'Now, write 0 bytes.π    Reg.AX = &H4000                 'Dos "Write file or device"π    Reg.BX = Handle%π    Reg.CX = 0                      'Write 0 bytesπ    Reg.DX = 0                      'These are not needed, but makeπ    Reg.DS = 0                      ' sure they're zero, just in caseπ    CALL InterruptX(&H21, Reg, Reg)π    IF Reg.Flags AND 1 THENπ        Status% = Reg.AXπ    END IFπ πTruncateExit:π    TruncateFile% = Status%π πEND FUNCTIONπDave Navarro, Jr.              PRUNE FILES AND DIRECTORY      comp.lang.basic.misc           Unknown Date           PB32                   73   1644     PRUNE.BAS   ' Prune all files in a directory tree and remove all directories.π' Released to the Public Domain by Dave Navarro, Jr.π' Requires PowerBASIC 3.2 or later.ππ$STACK 4096           'uses recursion, so use a large stackπ$INCLUDE "PB32.INC"ππDEFINT A-ZππDirec$ = UCASE$(COMMAND$)ππErCode = Prune(Direc$)ππSELECT CASE ErCodeπ  CASE 1 : PRINT Direc$; " not found!"π  CASE 2 : PRINT Direc$; " is not a directory!"πEND SELECTππEND ErCodeππFUNCTION Prune(BYVAL directory AS STRING) PUBLIC AS INTEGERππ  IF NOT Exist(directory) THENπ    FUNCTION = 1                 'directory not foundπ    EXIT FUNCTIONπ  END IFππ  IF (ATTRIB(directory) AND 16) <> 16 THENπ    FUNCTION = 2                 'not a directoryπ    EXIT FUNCTIONπ  END IFππ  KillFiles directoryππ  RMDIR directoryππEND FUNCTIONππSUB KillFiles(directory AS STRING) PRIVATEππ  DIM f            AS LOCAL STRINGπ  DIM DtaSeg       AS LOCAL INTEGERπ  DIM DtaOFs       AS LOCAL INTEGERπ  DIM OldDtaBuffer AS LOCAL STRINGππ  GetDTA DtaSeg, DtaOfsππ  DEF SEG = DtaSegπ    OldDtaBuffer = PEEK$(DtaOfs, 44)     'save current DTA informationπ  DEF SEGππ  directory = RTRIM$(directory, "\")π  PRINT directory + "\"ππ  f = DIR$(Directory + "\*.*",16)π  WHILE LEN(f)π    PRINT directory + "\" + fπ    IF ASCII(f) <> 46 THENπ      IF (DtaAttrib AND 16) = 16 THENπ        KillFiles directory + "\" + fπ        RMDIR directory + "\" + fπ      ELSEπ        KILL directory + "\" + fπ      END IFπ    END IFπ    f = DIR$π  WENDππ  DEF SEG = DtaSegπ    POKE$ DtaOfs, OldDtaBuffer           'restore saved DTA informationπ  DEF SEGππEND SUBπGreg Turgeon                   LOAD 16 COLOR PCX              comp.lang.basic.misc           Unknown Date           PB                     391  11537    LOADPCX.BAS '                    Contains LoadPCX16, a 16 color PCX image fileπ'                        loader for VGA graphics mode 12hπ'π'This file contains the following routines:π'π'SUB LoadPCX16(pcx$, Sline%, Col%)    16 color PCX file loaderπ'SUB LoadColorPCX16                   loads 16 color PCX data to VGA DAC regsπ'π'IMPORTANT: LoadPCX16 calls the routine VideoOff to blank the screenπ'while the PCX image is being loaded.  If you disable this feature,π'be sure to rem out both calls to VideoOff.π'π'ALSO IMPORTANT: LoadPCX16 allows an image smaller than full-screenπ'(640 X 480) to be repositioned on screen.  However, instead of theπ'coordinate system (X,Y), with X and Y identifying pixel positions,π'LoadPCX16 employs (Sline%, Col%) with Sline% identifying a verticalπ'screen pixel position and Col% following the text mode conventionπ'(in this case 0-79) for horizontal positioning.  The routine performsπ'error-checking for available repositioning space on-screen.π'π'As now written, the demo requires VGA.  LoadPCX16 calls the routineπ'LoadColorPCX16, which employs BIOS calls available only on color VGAπ'hardware.  Error checking for repositioning also assumes VGA mode 12hπ'(640 X 480) only.π'π'I first wrote LoadPCX16 in BASIC (PB 3.0c).  On my 386SX 16, loading theπ'test file (a fairly complex image originally generated by FRACTINT)π'from a RAM drive took over 90 seconds.  The routine as presented here,π'converted almost entirely to assembly, loads the same image in 1.8 seconds.π'π'My thanks to Murray Moffatt for his patience and persistence whileπ'testing LoadPCX16.π'π'Greg Turgeon - CIS: 76470,2417ππ$LIB GRAPH ONπ$LIB VGA ONπDECLARE FUNCTION GetStrLoc&( BYVAL AllocHandle% ) 'must be declaredππDEFINT A - Zπ%yes = -1: %no = 0ππ'''create variable to load w/PCX file header dataπTYPE PCXheaderπ  Mfg           AS BYTEπ  Version       AS BYTEπ  Encoding      AS BYTEπ  BitsPerPixel  AS BYTEπ  Xmin          AS INTEGERπ  Ymin          AS INTEGERπ  Xmax          AS INTEGERπ  Ymax          AS INTEGERπ  HorizontalRes AS INTEGERπ  VerticalRes   AS INTEGERπ  Pal           AS STRING * 48π  Reserved      AS BYTEπ  NumColrPlanes AS BYTEπ  BytesPerSLine AS INTEGERπ  PalInfo       AS INTEGERπ  Filler        AS STRING * 58πEND TYPEπDIM PIX1 AS SHARED PCXheaderππ'''use command$ to identify pix to loadπpcx$ = UCASE$( COMMAND$ )πIF ISFALSE( LEN( DIR$( pcx$ ))) THENπ  PRINT: PRINT "Cannot find PCX file "; pcx$π  ENDπEND IFππCALL LoadPCX16( pcx$, Sline%, Col% )πENDππ'===========================πSUB LoadPCX16( FileName$, BYVAL Sline%, BYVAL Col% )π  PCXfile = FREEFILEπ  OPEN FileName$ FOR BINARY AS PCXfileπ  DOShandle% = FILEATTR( PCXfile, 2 ) 'DOS handle needed for asmπ  FileBytes& = LOF( PCXfile )ππ'''load header into var & verify that PCX file is correct formatπ  get# PCXfile,, PIX1π  IF PIX1.Mfg < > 10 OR PIX1.Version < > 5 THEN 'Mfg 10 = ZSoft, Version 5 = 3.π    CLOSE PCXfileπ    PRINT: PRINT "mfg: "; PIX1.mfg, "Version"; PIX1.Versionπ    PRINT "Incorrect PCX version"π    EXIT SUBπ  END IFππ  PixWidth% = PIX1.Xmax - PIX1.Xminπ  PixHeight% = PIX1.Ymax - PIX1.Yminππ  PRINTπ  PRINT "Width: "; PixWidth%, "Height:"; PixHeight%π  PRINT "Encoding type:"; PIX1.Encodingπ  PRINT "Bits per pixel per plane:"; PIX1.BitsPerPixelπ  PRINT "Horizontal resolution of originating system:"; PIX1.HorizontalRes;π  PRINT "  Vertical resolution:"; PIX1.VerticalResπ  PRINT "Number of color planes:"; PIX1.NumColrPlanesπ  PRINT "Number of bytes per scan line per plane:"; PIX1.BytesPerSLineπ  PRINT "Palette info (color/bw = 1, grayscale = 2):"; PIX1.PalInfoπ  PRINT "File size: "; FileBytes&; " bytes"ππ  SLEEPπ  SCREEN 12ππ'''error checking: don't reposition image unless there's roomπ  MaxX% = 639: MaxY% = 479π  IF Sline% > ( MaxY% - PixHeight% ) - 2 THEN Sline% = 0π  IF Col% > (( MaxX% - PixWidth% ) \ 8 ) THEN Col% = 0ππ  PixBPerLine% = PIX1.BytesPerSLine 'create for asmπ  CALL LoadColorPCX16 'load PIX1.Pal colorsπ  SEEK PCXfile, 128 'start of screen dataππ  ChunkSize% = FRE( t$ ) 'create largest buffer possibleπ  FileBuffer$ = STRING$( ChunkSize%, 0 ) '(reduce size to smooth out display ifππ  ! push WORD ptr FileBuffer$π  ! CALL getstrloc; now dx: ax = LOC, cx = lengthπ  ! mov FBytesSeg??, dx; SAVE SEG & addr of FileBuffer$π  ! mov FBytesPtr??, axπ'''establish offset if repositioning imageπ  ! mov ax, Sline%π  ! mov dx, 80π  ! mul dxπ  ! add ax, Col%π  ! mov Mover??, axπ'''determine how many bytes per line for the current video modeπ'''bytes per line will = screen column figure in BIOS data areaπ  ! xor bx, bxπ  ! mov es, bxπ  ! mov bx, &h44Aπ  ! mov ax, es: [bx]π  ! mov BPerLine%, axπ  ! CALL LoadChunk        ; load FileBuffer$π  ! mov ScreenLine%, -1   ; start AT - 1 TO allow FOR inc TO 0π'''begin loading pix to screenπNewLine:π  ! inc ScreenLine%π  ! mov dx, ScreenLine%π  ! cmp dx, PixHeight%    ; IF ScreenLine% > PixHeight%, THEN PixDoneπ  ! jle LineOKπ  ! jmp PixDoneπLineOK:π  ! mov ax, BPerLine%     ; Addr?? = BPerLine% * ScreenLine%π  ! imul dxπ  ! mov di, ax            ; di = target SCREEN address FOR loadingπ  ! add ax, PixBPerLine%  ; LineEnd?? = Addr?? + PixBPerLine%( PIX1.BytesPerSLiπ  ! mov LineEnd??, axπ'''si = ptr to position in FileBuffer$, Plane% = target video planeπ  ! mov Plane%, 0         ; begin each LINE w / plane 0π  ! CALL SelectPlaneπNewByte:π  ! cmp Plane%, 3         ; done WITH ALL 3 planes?π  ! ja NewLine            ; IF yesπ  ! CALL GetNextByte      ; IF no, load a BYTE into al FROM FileBuffer$π  ! mov ah, al            ; make a copy of NextByte?π  ! AND al, 192           ; IF top 2 BITS NOT set, THEN load the one BYTEπ  ! cmp al, 192           ; IF set, THEN it 's a repeater, so load theπ  ! je RepByte            ; bytes AND assume continuing ON same LINEπ  ! mov al, ah            ; RESTORE al = NextByte?, AND load BYTEπ  ! push di               ; SAVE di( stosb increases di )π  ! mov dx, &h0A000       ; BASE video SEGπ  ! add di, Mover??       ; add ANY repositioning valueπ  ! stosb                 ; load the BYTE TO SCREENπ  ! pop diπ  ! inc di                ; update position FOR loadingππ  ! mov ax, LineEnd??     ; check: AT the END of a SCREEN line?π  ! cmp ax, diπ  ! ja NewByte            ; IF noπ  ! mov ax, ScreenLine%   ; IF yes, THEN move back TOπ  ! mov bx, BPerLine%     ;π  ! imul bx               ; start of LINE AND switchπ  ! mov di, ax            ;π  ! inc Plane%            ; TO NEXT video planeπ  ! CALL SelectPlaneπ  ! jmp NewByteπRepByte:π'''coming in, ah = NextByte?π  ! mov al, ah            ; RESTORE al = NextByte?π  ! AND al, 63            ; CLEAR BITS 6&7 TO leave theπ  ! mov cl, al            ; number of times TO REPEATπ  ! xor ch, chπ  ! CALL GetNextByte      ; load the COLOR BYTE into alπDoTheReps:π  ! push diπ  ! mov dx, &h0A000π  ! mov es, dx            ; di already = addressπ  ! add di, Mover??       ; add ANY repositioning valueπ  ! stosb; load TO videoπ  ! pop diππ  ! inc diπ  ! cmp di, LineEnd??     ; AT END of line?π  ! je NextPlane          ; IF yes, GOSUB NextPlaneπDoNextRep:π  ! LOOP DoTheReps        ; IF noπ  ! jmp NewByteπNextPlane:π  ! push axπ  ! push dxπ  ! mov ax, ScreenLine%   ; move back TO start of LINEπ  ! mov dx, BPerLine%     ; ANDπ  ! imul dx               ; move TO NEXT video planeπ  ! mov di, axπ  ! inc Plane%π  ! pop dxπ  ! pop axπ  ! CALL SelectPlaneπ  ! jmp DoNextRepπPixDone:π'''reset all planesπ  ! mov ax, &h0F02π  ! mov dx, &h3C4π  ! OUT dx, axππ  CLOSE PCXfileππ  SLEEPππ  SCREEN 0π  EXIT SUBπGetNextByte:π'''don't push ax; it sends back NextByte?π  ! push bxπ  ! push cxπ  ! push esππ  ! mov es, FBytesSeg??π  ! mov bx, FBytesPtr??π  ! add bx, si; si = FileBuffer$ BYTE ptr, so bx now - > NextByte?π  ! mov al, BYTE ptr es: [bx]; now al = NextByte?ππ  ! inc si; increase FileBuffer$ ptrπ  ! dec BuffPtr%; decrease ptr FOR countdownπ  ! jnz ChunkNotDone; IF more IN FileBuffer$π  ! CALL LoadChunk; IF empty, THEN GET moreπChunkNotDone:π  ! pop esπ  ! pop cxπ  ! pop bxπ  ! retnπLoadChunk:π  ! push axπ  ! push bxπ  ! push cxπ  ! push dxπ  ! push dsπ'if FileBytes& =< ChunkSize% then ChunkSize% = FileBytes&π  ! mov ax, FileBytes&[00]π  ! mov dx, FileBytes&[02]π  ! cmp dx, 0            ; IF dx < > 0 THEN FileBytes& mustπ  ! jg SameSize          ; be > ChunkSize%π  ! cmp ax, ChunkSize%π  ! jle SameSize         ; IF FileBytes& < ChunkSize%, THEN makeπ  ! mov ChunkSize%, ax   ; ChunkSize% = FileBytes& FOR final passπSameSize:π  ! mov bx, FBytesSeg??π  ! mov ds, bxπ  ! mov dx, FBytesPtr??π  ! mov bx, DOShandle%π  ! mov cx, ChunkSize%π  ! mov ah, &h3F; reload FileBuffer$π  ! INT &h21π  ! jnc ReCalcπErrorHandler:π  ! mov ChunkSize%, axπ  ! pop dsπ  ! pop dxπ  ! pop cxπ  ! pop bxπ  ! pop axπ  CLOSEπ  LOCATE 1, 1π  IF ISTRUE( ChunkSize% ) THENπ    SOUND 800, .5: PRINT "Error: "; ChunkSize%π  END IFπ  getkeyπ  SCREEN 0π  ENDπReCalc:π  ! mov ax, FileBytes&[00]  ; recalculate size of remaining FileBytes&π  ! mov dx, FileBytes&[02]π  ! mov bx, ChunkSize%      ; subtract portion already loaded TO SCREENπ  ! SUB ax, bxπ  ! sbb dx, 0π  ! mov FileBytes&[02], dxπ  ! mov FileBytes&[00], axπ  ! xor si, si              ; si = FileBuffer$ ptr FOR loading; start AT 0π  ! mov ax, ChunkSize%π  ! mov BuffPtr%, ax        ; ptr FOR countdownππ  ! pop dsπ  ! pop dxπ  ! pop cxπ  ! pop bxπ  ! pop axπ  ! retnπSelectPlane:π  ! push axπ  ! push bxπ  ! push cxπ  ! push dxππ  ! mov ax, 1; determine 2 ^ planeπ  ! cbwπ  ! mov cx, Plane%π  ! shl ax, clπ  ! mov ah, al; ah now = plane desiredπ  ! mov dx, &h3C4; plane SELECTπ  ! mov al, 2π  ! OUT dx, axππ  ! pop dxπ  ! pop cxπ  ! pop bxπ  ! pop axπ  ! retnπEND SUBππ'===========================πSUB LoadColorPCX16π  NumBytes?? = LEN( PIX1.Pal )π  Addr1?? = VARPTR( PIX1.Pal )π'''palette regs actually index -> DAC regsπ'''build array of the DAC regs to which palette regs (0-15) are indexedπ  REDIM temp?( 0: 15 )π  RESTORE DefaultDACregsπ  FOR a? = 0 TO 15: READ temp?( a? ): NEXT a?π    DACValSeg?? = VARSEG( temp?( 0 )): DACValPtr?? = VARPTR( temp?( 0 ))π'''reduce PCX 0-255 color values to 0-63π    ! push axπ    ! push bxπ    ! push cxπ    ! push dxπ    ! push esπ    ! push siπ    ! push di; make both ds: si & es: di - > PIX1.Palππ    ! mov ax, ds; ALL fixed length strings are IN dsπ    ! mov es, axπ    ! mov ax, Addr1??π    ! mov si, axπ    ! mov di, axπ    ! mov cx, NumBytes??π    ! cld; incrementπReducer:π    ! lodsbπ    ! shr al, 1; \ 4 TO reduceπ    ! shr al, 1π    ! stosbπ    ! LOOP Reducerπ'''load each DAC regπ    ! mov si, Addr1??; now ds: [si] = PIX1.Palπ    ! mov es, DACValSeg??π    ! mov di, DACValPtr??; es: [di] = temp%( 0 )π    ! mov cx, 16π    ! mov ax, &h1010π    ! xor bx, bxπLoadRegs:π    ! push cxπ    ! mov bl, BYTE ptr es: [di]; pal REGπ    ! mov dh, BYTE ptr ds: [si]; redπ    ! inc siπ    ! mov ch, BYTE ptr ds: [si]; greenπ    ! inc siπ    ! mov cl, BYTE ptr ds: [si]; blueπ    ! inc siππ    ! push bpπ    ! INT &h10π    ! pop bpππ    ! pop cxπ    ! inc di; NEXT pal REGπ    ! LOOP LoadRegsππ    ! pop diπ    ! pop siπ    ! pop esπ    ! pop dxπ    ! pop cxπ    ! pop bxπ    ! pop axπ    ERASE temp?π    EXIT SUBπDefaultDACregs:π    DATA 0, 1, 2, 3, 4, 5, 20, 7, 56, 57, 58, 59, 60, 61, 62, 63πEND SUBπDuane Jahnke                   256 COLORS IN SCREEN 12        256,COLORS,SCREEN,12           06-14-92 (14:32)       QB, QBasic, PDS        125  3939     COLR256K.BAS'NOTE: VGA required to run this program.ππ'This program demonstrates how to calculate and display the 256k colorsπ'available in SCREEN 12.  The formula used below looks kind of crypticπ'at first, but it will begin to make sense after you think aboutπ'how colors work.ππ'There are 3 basic colors: red, green, and blue.π'In SCREEN 12, each of these colors has an intensity range of 0 to 63π'That gives a total of 64 shades for each one.π'Therefore, 64 * 64 * 64 = 262144 (256k) possible colors.π'Sounds good, well the down side is that BASIC can only displayπ'16 of them at one time, oh-well.π'Red's palette begins at 0π'Green's palette begins at 256π'Blue's palette begins at 65536π'Therefore, the palette formula is:π'       PalColor& = (65536 * blue%) + (256 * green%) + red%ππ'Enough of that, run this and see what you think.ππ'--------------------------------------------------------------------------πON ERROR GOTO ETrap     'set an error trapπSCREEN 12       'set the screen modeπPALETTE 1, 0    'assign black to color attribute #1 to use as the defaultππw% = 100: x% = 50         'set the viewport boundry coordinate var'sπy% = 540: z% = 300πVIEW SCREEN (w%, x%)-(y%, z%), 0, 15    'define a viewport w/ borderπLINE (w%, x%)-(y%, z%), 1, BF           'draw a box, fill w/ color 1ππCOLOR 15        'put options on the screenπLOCATE 3, 14: PRINT "PALETTE VALUE:"πLOCATE 21, 14: PRINT "R = More red                         Red intensity:"πLOCATE 22, 14: PRINT "r = Less red"πLOCATE 24, 14: PRINT "G = More green                     Green intensity:"πLOCATE 25, 14: PRINT "g = Less green"πLOCATE 27, 14: PRINT "B = More blue                       Blue intensity:"πLOCATE 28, 14: PRINT "b = Less blue"πLOCATE 30, 35: PRINT "Esc = Quit";ππDO  'loop here and update the palette and data w/ each key hitππ    a& = (65536 * blue%) + (256 * green%) + red%   'calc the new paletteππ    PALETTE 1, a&   'display the new paletteππ    LOCATE 3, 28: PRINT a&; "     "   'update the screen dataπ    LOCATE 21, 65: PRINT red%π    LOCATE 24, 65: PRINT green%π    LOCATE 27, 65: PRINT blue%ππ    DO: k$ = INKEY$      'wait for a user keyπ    LOOP WHILE k$ = ""ππ    SELECT CASE k$       'process the keyπ        CASE "R"π            IF red% < 63 THEN        'increment red intensityπ                red% = red% + 1π            ELSEπ                SOUND 200, .1π            END IFππ        CASE "r"π            IF red% > 0 THEN         'decrement red intensityπ                red% = red% - 1π            ELSEπ                SOUND 200, .1π            END IFππ        CASE "G"π            IF green% < 63 THEN      'increment green intensityπ                green% = green% + 1π            ELSEπ                SOUND 200, .1π            END IFππ        CASE "g"π            IF green% > 0 THEN       'decrement green intensityπ                green% = green% - 1π            ELSEπ                SOUND 200, .1π            END IFππ        CASE "B"π            IF blue% < 63 THEN       'increment blue intensityπ                blue% = blue% + 1π            ELSEπ                SOUND 200, .1π            END IFππ        CASE "b"π            IF blue% > 0 THEN        'decrement blue intensityπ                blue% = blue% - 1π            ELSEπ                SOUND 200, .1π            END IFπ       π        CASE CHR$(27)ππ        CASE ELSEπ            SOUND 200, .1ππ    END SELECTπLOOP UNTIL k$ = CHR$(27)    'exit if escape is hitππVIEW        'close the viewportπCLSπPALETTE     'reset the palette to defaultπSCREEN 0ππ'print the final palette dataπPRINT "FINAL PALETTE VALUE   :"; a&πPRINT "RED INTENSITY         :"; red%πPRINT "GREEN INTENSITY       :"; green%πPRINT "BLUE INTENSITY        :"; blue%ππDone:πENDππETrap:π    CLS     'display the error code and exit programπ    PRINT "BASIC RUNTIME ERROR #"; ERRπRESUME DoneππUnknown Author(s)              SORTING AND OTHER FAQS         FidoNet QUIK_BAS Echo          Unknown Date           TEXT                   930  36400    QUIKBAS.FAQ ****************************************************************ππππ    *     The QUIK_BAS List of Frequently Asked Questions withππ    *             Some Simple Public Domain Solutionsπππ****************************************************************πππTABLE OF CONTENTS:ππ        q1.0    The BASICS of BASICπ                s1.0    QUIKSORT.BAS    -- recursive quicksort SUBππ        q2.0    Commonly Requested Routinesπ                s2.0    HUTHSORT.BAS    -- iterative quicksort SUBπ                s3.0    BISEARCH.BAS    -- binary search FUNCTIONππ        q3.0    Advanced Topics         -- "Hashing in QuickBASIC"π                t1.0    Hashing Collision Tableπ                s4.0    FSTPRIME.BAS    -- generates 4K+3 prime numberπ                t2.0    List Management System Ratingsπ                s5.0    WORDHASH.BAS    -- word distribution counterππ        q4.0    Structured BASIC TechniquesπππNOTE:   All source remains the property of those who originally wroteπ        it, as understood by Canadian, American, and Internationalπ        Treaty.ππ        The text portion of this file itself is hereby released into theπ        "Public Domain" for the purposes of education and enlightenment.πππQ1.0    The BASICS of BASIC:ππQ1.4    Okay, I've figured out FUNCTIONs and SUBs, and have evenπ        started using them with some kind of skill.  Now, thing is, Iπ        come up to this thing called 'recursion.'  What's this allπ        about, and can you show me some practical application of it?ππA1.4    There is an old joke about the cryptic nature of dictionariesπ        that goes something like this:ππ        re'CUR'sion (noun) 1. see recursionππ        Actually, that's a pretty sad joke.  One computer scientist'sπ        definition states:ππ        "... a recursive algorithm is one that contains a copy of itselfπ        within one of its instructions.  Thus, a recursive algorithm isπ        reminiscent of a set of mirrors in which you can see yourselfπ        looking at yourself looking at yourself."  [J. Glenn Brookshear]ππ        Recursion is a powerful programming tool, and any comprehensiveπ        programming language allows it.  QuickBASIC and its dialects areπ        no exception.  A simple example of recursion:ππ        SUB recurseπ            recurseπ        END SUBππ        This thing will go in circles until the stack is full, crashingπ        the program should it ever be called.  It illustrates two of theπ        main pitfalls of recursion:ππ             1. recursion in QuickBASIC eats the stack for breakfastπ             2. there must be a terminating condition to exit the loopππ        Since each call to a SUB or FUNCTION does some pushing to theπ        stack, it must always be remembered that recursive routines willπ        require a bit of the stack for every instance they are called.π        It is sometimes hard to know in advance how many times aπ        recursive routine will end up calling itself, and therefore, oneπ        cannot know with any accuracy how much a given recursive routineπ        will decide to rob from the stack.  Be warned!ππ        This also leads to the next issue: there must ALWAYS be aπ        terminating condition to exit the loop.  Sometimes it is easy toπ        overlook this point.  Consider the above simple example.  Itπ        never stops calling itself, does it?  Were a theoreticalπ        computer to exist that had a theoretically infinitely largeπ        stack that could never be consumed by even the deepest level ofπ        recursion, what happens if that routine goes off into a cornerπ        and keeps calling itself?  It results in a permanent time outπ        known as a crash. (The moral of this?  A bug on a i486 system isπ        still a bug, just a bug that happens sooner.)ππ        An example of a terminating condition added to the above code:ππ        SUB recurse(n%)π        n% = n% + 1π        IF n% < 10 THENπ                recurseπ        END IFπ        END SUBππ        This SUB will call itself only until n% is equal to ten, atπ        which point, it will reach its terminating state, and beπ        finished on its job.  This is a simple example, I admit, butπ        NEVER forget to include a terminating statement in yourπ        recursive routines, or you will pay for it with a crash.ππ        Now that we have that out of the way, let's kill two birds withπ        one stone.  (It could be argued, in fact that the act of killingπ        two birds with only one stone probably involves recursionπ        somewhere in the solution.)  Everyone wants to know a goodπ        QuickSort algorithm, and most implementations of that useπ        recursion.  So, a modified version of the QuickSort SUB fromπ        Microsoft, one that sorts an array passed to it:ππS1.0    QUIKSORT.BAS [F210S01.BAS]ππDEFINT A-ZπSUB QuickSortSTR (Array() AS STRING, Low, High)π'            /^\              /^\π'             |                |π'    Change these to any BASIC data type for this routine toπ'    handle other types of data arrays other than strings.π'π'============================== QuickSortXXX ================================π'  QuickSortXXX works by picking a random "pivot" element in Array(), thenπ'  moving every element that is bigger to one side of the pivot, and everyπ'  element that is smaller to the other side.  QuickSortXXX is then  calledπ'  recursively with the two subdivisions created by the pivot.  Once theπ'  number of elements in a subdivision reaches two, the recursive calls endπ'  and the array is sorted.π'===========================================================================π'π'            Microsoft's source code modified as neededπ'ππSTATIC BeenHereππIF NOT BeenHere THENπ        Low = LBOUND(Array)π        High = UBOUND(Array)π        BeenHere = -1πEND IFππDIM Partition AS STRING  ' Change STRING to any BASIC data typeπ                         ' for this QuickSort routine to work withπ                         ' things other than strings.ππ   IF Low < High THENππ      ' Only two elements in this subdivision; swap them if they are outπ      ' of order, then end recursive calls:ππ      IF High - Low = 1 THEN ' we have reached the terminating condition!π         IF Array(Low) > Array(High) THENπ            SWAP Low, Highπ            BeenHere = 0π         END IFπ      ELSEππ         ' Pick a pivot element at random, then move it to the end:π         RandIndex = INT(RND * (High - Low + 1)) + Lowπ         SWAP Array(High), Array(RandIndex)π         Partition = Array(High)π         DOππ            ' Move in from both sides towards the pivot element:π            I = Low: J = Highπ            DO WHILE (I < J) AND (Array(I) <= Partition)π               I = I + 1π            LOOPπ            DO WHILE (J > I) AND (Array(J) >= Partition)π               J = J - 1π            LOOPππ            ' If we haven't reached the pivot element, it means that twoπ            ' elements on either side are out of order, so swap them:π            IF I < J THENπ               SWAP Array(I), Array(J)π            END IFπ         LOOP WHILE I < Jππ         ' Move the pivot element back to its proper place in the array:π         SWAP Array(I), Array(High)ππ         ' Recursively call the QuickSortSTR procedure (pass the smallerπ         ' subdivision first to use less stack space):π         IF (I - Low) < (High - I) THENπ            QuickSortSTR Array(), Low, I - 1π            QuickSortSTR Array(), I + 1, Highπ         ELSEπ            QuickSortSTR Array(), I + 1, Highπ            QuickSortSTR Array(), Low, I - 1π         END IFπ      END IFπ   END IFπEND SUBππ'=======>8 SAMPLE 1.0 ENDS HERE 8<=========ππQ1.5    So that's how to use recursion!  That's great!  I think I'mπ        starting to get a hang of things with QuickBASIC now, thanks.π        But, how is it possible for it to call itself over and overπ        like that without all those variables interfering withπ        each other?  I mean, I'm kind of used to GW-BASIC, and well,π        I just can't figure out why all those High and Low variablesπ        don't just write over one another.  My docs say something aboutπ        local and global scope, but it's all kind of confusing.  What'sπ        the real difference between local, STATIC, COMMON, SHARED, COMMONπ        SHARED, and all other flavors of variables?ππA1.5    Beginners with QuickBASIC sometimes have a hard time decryptingπ        all of the different types of variable scope.  Microsoft hasn'tπ        really helped anything with all the funny names for variableπ        scope.  GLOBAL would have made more sense than SHARED for most.π        Okay, let's look at how the QuickBASIC program is inevitablyπ        structured:ππ                1.  First, there is the 'module' level.  That is theπ                    main part of the QuickBASIC program, the part whereπ                    execution starts, and most programmers declare theirπ                    constants, and put their main documentation.ππ                2.  Second, there is the SUB and FUNCTION level.  Eachπ                    SUB and FUNCTION could be thought of as a miniprogramπ                    unto itself.  That's why SUBs are called that:π                    subprogram.ππ                3.  Third, if you write bigger programs, you may actuallyπ                    have two or more modules, each one having its ownπ                    SUBs and FUNCTIONs.ππ        Okay, then, any variable used at the modular level, or level 1, isπ        accessible, or in the 'scope' of the modular level.  If there isπ        a variable called Foo at the modular level, with a value of 7, thenπ        any Foo at the SUB or FUNCTION level could also be called Foo,π        without interfering with the modular Foo.  Think of each moduleπ        level variable and each SUB and FUNCTION variable as being onπ        different continents.  They can have the same name with no problem.ππ        But, suppose you want a SUB or FUNCTION to have access to theπ        Foo that was declared at the modular level.  This is where theπ        SHARED declarator comes in.  In the SUB somesubprog, to haveπ        access to the Foo that was declared at the modular level, justπ        add the declaration:ππ        SHARED Fooππ        Any SUB or FUNCTION that doesn't want to have access to theπ        modular Foo doesn't have to declare it as SHARED.  This is aπ        powerful feature, once you get the hang of it and feel confidentπ        enough to use it wisely.ππ        Now, suppose that you want a number of your SUBs or FUNCTIONs toπ        have access to a common group of variables.  At the modularπ        level, the declaration would be:ππ        DIM SHARED Fooππ        This would give ALL of the SUBs and FUNCTIONs of a given moduleπ        access to the variable Foo.  Any access of Foo at any level willπ        alter the global variable.ππ        Now, suppose you have a multimodule program that has FIRST.BASπ        and SECOND.BAS linked together.  Suppose you want them toπ        communicate with one another via a common global variable.  Thisπ        is where COMMON SHARED comes in.ππ        Now that we've covered this, there is the issue of the STATICπ        declarator.  Normally, variables at the SUB and FUNCTION levelπ        are dynamic, which means they disappear when the routine returnsπ        to the place that it was called from.  By declaring a variableπ        STATIC, we can be assured that whatever the variable's value wasπ        when we left, it will be when we return.  To declare only a fewπ        of the variables as STATIC, use the form:ππ        SUB FooSub ()π        STATIC Variable1, Variable2, etc.π        :π        :π        END SUBπ        But, if you want ALL the variables to be STATIC, use the followingπ        method:ππ        SUB FooSub () STATICπ        :π        :π        :π        END SUBππ        There are certain speed advantages to STATIC SUBs and FUNCTIONs,π        since variables are not created on the stack, but that is a moreπ        advanced issue.ππ        So, in summary:ππ        1.  SHARED allows SUBs and FUNCTIONs to use modular variables,π        2.  COMMON allows modules to share variables between themselves,π        3.  STATIC allows variables to retain their value betweenπ            calls to the SUB or FUNCTION in question.ππQ2.0    Commonly Requested Routines:ππQ2.4    Okay, I've looked the whole thing over and I've realizedπ        something: the recursive QuickSortXXX routine eats the stack upπ        pretty fast.  Is there another way?  Is there a way to implementπ        a QuickSort SUB without using recursion?ππA2.4    Yes, indeed there is.  Cornel Huth implemented an iterativeπ        quicksort algorithm, which I then tweaked a bit.  It is actuallyπ        a bit faster than the other, and doesn't use too much of the stack.π        It accomplishes this by using an array to simulate a stack. Theπ        modified version follows:ππS2.0    HUTHSORT.BAS [P210S02.BAS]ππ' HUTHSORT.BAS written by Cornel Huthπ' Iterative QuickSort Routineπ'πSUB subHuthSortSTR (Array() AS STRING)π'               ^  TWEAK THESE    ^π'               | FOR OTHER TYPES |π'               `--+--------------'π'                  Vπ  DIM compare AS STRINGππTYPE StackTypeπ  low AS INTEGERπ  hi AS INTEGERπEND TYPEππDIM aStack(1 TO 128) AS StackTypeππ  StackPtr = 1π  aStack(StackPtr).low = LBOUND(Array)π  aStack(StackPtr).hi = UBOUND(Array)π  StackPtr = StackPtr + 1ππ  DOπ    StackPtr = StackPtr - 1π    low = aStack(StackPtr).lowπ    hi = aStack(StackPtr).hiπ    DOπ      i = lowπ      j = hiπ      mid = (low + hi) \ 2π      compare = Array(mid)π      DOπ        DO WHILE Array(i) < compareπ          i = i + 1π        LOOPπ    DO WHILE Array(j) > compareπ          j = j - 1π        LOOPπ        IF i <= j THENπ          SWAP Array(i), Array(j)π          i = i + 1π          j = j - 1π        END IFππ      LOOP WHILE i <= jπ      IF j - low < hi - i THENπ        IF i < hi THENπ          aStack(StackPtr).low = iπ          aStack(StackPtr).hi = hiπ          StackPtr = StackPtr + 1π        END IFπ        hi = jπ      ELSEπ        IF low < j THENπ          aStack(StackPtr).low = lowπ          aStack(StackPtr).hi = jπ          StackPtr = StackPtr + 1π        END IFπ        low = iπ      END IFπ    LOOP WHILE low < hiπ    'IF StackPtr > maxsp THEN maxsp = StackPtrπ  LOOP WHILE StackPtr <> 1πEND SUBππ=======>8 SAMPLE 2.0 ENDS HERE 8<=========ππQ2.5    Now that I've got so many neat ways to sort a list, I'd sure likeπ        to be able to locate an entry in it quickly.  I hear that a binaryπ        search is fast, but I just can't figure out how to do that.  Howπ        do I do a binary search?ππA2.5    Binary searches are the fastest overall search method forπ        standard sorted lists.  Such lists can be divided in two, lookedπ        at, and divided again as necessary.  A good search method isπ        demonstrated here:ππS3.0    BISEARCH.BAS [F210S03.BAS]πππDEFINT A-ZπFUNCTION BiSearchSTR (Find AS STRING, Array() AS STRING)ππMin = LBOUND(Array)             'start at first elementπMax = UBOUND(Array)             'consider through lastππDOπ  Try = (Max + Min) \ 2         'start testing in middleππ  IF Array(Try) = Find THEN     'found it!π    BiSearch = Try              'return matching elementπ    EXIT DO                     'all doneπ  END IFππ  IF Array(Try) > Find THEN     'too high, cut in halfπ    Max = Try - 1π  ELSEπ    Min = Try + 1               'too low, cut other wayπ  END IFπLOOP WHILE Max >= MinππEND FUNCTIONππ=======>8 SAMPLE 3.0 ENDS HERE 8<=========ππQ3.0    Advanced Topics -- "Hashing in QuickBASIC"πQ3.1    That's pretty fast!  I was so used to doing a sequential searchπ        on an unsorted list.  Now that I have the QuickSort and theπ        BiSearch routines, I can use them as a pair for faster listπ        searches.ππ        The thing is, as soon as I want to add something to the list, itπ        puts everything out of order by only one entry, and that hardlyπ        seems worth sorting all over again, even with something as fastπ        as Cornel Huth's iterative QuickSort algorithm.  Are there anyπ        alternatives to this way of doing things?  I've heard talk ofπ        something called 'hashing' but I don't have any idea of whatπ        that is all about.  How would I use hashing to avoid having toπ        either resort the list, or use a slow insertion algorithm?π        Insertion is horrendously slow with disk files.ππA3.1    Hashing is a very efficient method of record access, be it inπ        RAM or be it with a disk file.  Basically, hashed arrays or dataπ        files can be quickly searched for a given item by a key index.π        Whenever you have to add an item to the list, you can atπ        lightening speed, and since hashing "sorts" the arrayπ        on-the-fly, as it were, there is no need to push records aroundπ        to add new items to a hashed record.ππ        The first concept you must understand with hashing is the keyπ        index. Every data structure you design with hashing in mind hasπ        to have one field that is unique.  This is a prerequisite thatπ        you just can't get around.  Of course, you could actuallyπ        combine several fields to generate this unique key, whichπ        effectively serves the same purpose.  A good application of thisπ        is a Fidonet nodelist that uses the node address as the hashingπ        key.  No two alike in theory.ππ        But just how does this key work?  First of all, let's take aπ        look at the Fidonet example.  Every full Fidonet address isπ        unique to one node.  Assume that the full nodelist has aboutπ        15000 entries. Okay, if you want a hashing table to hold 15000π        unique entries, then research has shown that the table should beπ        at least 30% greater than the number of entries in it.  Thatπ        would make 19500 table entries.  This means that 4500 entries inπ        the list will be left empty for best hashing results.ππ        Now, another problem comes up.  How does the key come intoπ        play? Well, let's look at a simple key: 1153999.  Since the listπ        is 19500 long, we certainly can't just put this in recordπ        1153999. Hashing involves dividing the key by the table size andπ        taking the remainder and using that as the record number:ππ                           59π                    ----------  R 3499π               19500) 1153999πππ        Okay, 3499 is the record number in which we would put the data.π        This is the basic idea behind hashing.  There is a trouble,π        however. Collision occurs whenever a node address, when dividedπ        by 19500 has a remainder of 3499.  That 'bucket' is alreadyπ        full!  So, what to do?  Generate another bucket number, see ifπ        that bucket is full, and if it is, keep generating new bucketsπ        until we find an empty bucket.ππ        To find an item in a hashed table, we get its key, divide by theπ        table size, and look at the bucket that is represented by theπ        remainder.  If that isn't the one, we generate the next bucketπ        address, until we arrive at an empty bucket.  If we encounterπ        the correct key BEFORE we arrive at an empty bucket, then we'veπ        found our entry.  If we arrive at an empty bucket, the record isπ        not in the table.  And there you have hashing.ππ        A well designed hashing table will yield this number ofπ        collisions per insertion or search:πππT1.0    Hashing Collision Tableππ        TABLE FULLNESS          COLLISIONSπ        ==================================π             50%                   2.0π             60%                   2.5π             70%                   3.3π             90%                  10.0πππ=======>8 TABLE 1.0 ENDS HERE 8<=========ππ        That shows better results than even the binary search, withπ        large lists!ππ        Research has shown that the most efficient hashing tables, thatπ        is, the ones with the least number of collisions, have a primeπ        number of entries.  A table size of 1019 should produce lessπ        collisions than one of 1000.  Research has also shown that ifπ        the prime is of the form 4K+3, where K is any positive integer,π        then collisions are reduced even further.  1019 also meets thisπ        second requirement.  But, since a table size twice the size ofπ        the maximum number of entries it will ever hold is inefficient,π        the 4K+3 criterion should be abandoned at a certain point inπ        favor of any prime number.  Since most of us aren't idiotπ        savants who can just come up with that number to suit our needs,π        here is a FUNCTION, written by Charles Graham, that accepts theπ        maximum number of entries a table will have, and returns theπ        proper type of prime number, to be used as a hashing table size:ππS4.0    FSTPRIME.BAS [F210S04.BAS]ππDEFINT A-Zππ' This FUNCTION returns a prime number that is at least 30% greater thanπ' threshold.  It will TRY to return a prime number that also fits into theπ' form 4K+3, where k is any integer, but if the prime number is twice theπ' size of the threshold, it will ignore this criterion.π'π'     Written by Charles Grahamπ'πFUNCTION funFirstPrime (threshold)πCONST TRUE = -1πCONST FALSE = NOT TRUEππtp30 = INT((threshold * 1.3) + .5)πIF tp30 / 2 = tp30 \ 2 THENπ    tp30 = tp30 + 1πEND IFπc = tp30 - 2πIF c < 1 THENπ    c = 1πEND IFπt2 = threshold * 2πDOπ    c = c + 2π    FOR z = 3 TO SQR(c)π        ind = TRUEπ        IF c / z = c \ z THENπ            ind = FALSEπ            EXIT FORπ        END IFπ    NEXT zπ    IF ind THENπ        IF (c - 3) / 4 = INT((c - 3) / 4) OR c > t2 THENπ            funFirstPrime = cπ            EXIT DOπ        END IFπ    END IFπLOOPπEND FUNCTIONππ=======>8 SAMPLE 4.0 ENDS HERE 8<=========ππQ3.1    How do I know when to use sequential searches, when to useπ        binary searches, and when to use hashing?  Are there any sortπ        of guidelines?ππA3.1    Well, first let's consider where hashing is in its prime.π        (You'll pardon that one, okay?)  It is best suited to dynamicπ        list generation where items need to be added on a regular basis,π        but not deleted, since deletion is fairly difficult to implementπ        on a hashed list.  The main strength of a hashing system is itsπ        ability to quickly insert new items into the table in such aπ        manner that they can be located quickly "on-the-fly."   (Seeπ        T1.0 for the average number of collisions before locating theπ        correct entry.)ππ        Since the collisions increase with the ratio of fullπ        buckets to empty buckets, and not with the size of the actualπ        table involved, hashing is more efficient than even binaryπ        searches when lists start to become huge.  Also, because theπ        binary method of searching demands a sorted list, insertion ofπ        items at a later time becomes very cumbersome, even with suchπ        techniques as the QuickSort and pushing all entries after theπ        insertion up by one.  (Try that technique on a list of 30,000π        items, when you only want to add two new items that land nearπ        the beginning of the list, and you'll know what disk wear andπ        tear is all about!)ππ        Typical applications of the hashing algorithm involve wordπ        distribution counts, dictionary table generators that involveπ        dictionaries that will be added to dynamically, and things ofπ        that nature.ππ        Consider the word distribution count problem.  Each word is aπ        unique key, and so is perfect for hashing.  Sequential methodsπ        only work well up until the table has so many entries in it thatπ        looking up entries in the table becomes a real effort. Remember,π        words already in the list do not need to be added twice. Binaryπ        methods allow for quick searching, but each case of a new wordπ        being added to the list requires a sort or cumbersome insertion.π        This takes time, if a text file is of even average length.ππ        Hashing, on the other hand, can increment the count of wordsπ        already in the list, or add new words to the list, without theπ        overhead of sorting, sequential searches, or push-typeπ        insertion.  Also, remember that entry deletion is a problem withπ        hashing.  Word distribution counts NEVER require entries to beπ        struck, and so are well-suited to hashing systems.ππ        A good rule of thumb to determine which method may be best for aπ        given problem is to cosider the points on this table:ππT2.0    List Management System Ratingsππ                                      List  Typeπ                        SEQUENTIAL      BINARY          HASHEDπ                =====================================================πsmall list                  1              3              2πmedium list                 3              1              2πlarge list                  3              2              1πhuge list                   3              2              1ππInsertion                   2              3              1πModification                3              2              1πDeletion                    1              2              3πBrowsing                    2              1              3ππ                     (Systems are ranked first, second, or third)ππ=======>8 TABLE 2.0 ENDS HERE 8<=========ππ        Using this table, we can see that the best method for shortπ        lists that require frequent deletions might be the sequentialπ        list.  The best for huge lists that require insertions,π        modifications, but not deletions (such as a nodelist index) isπ        probably a hashed list.  A hashed list, however, will not doπ        much for you if you regularly want to access the next item,π        first item in the list, or last item, such as in a list browsingπ        system.  Hashed lists have no logical beginning or end, and forπ        this reason, there is no such thing as a "first item" or "nextπ        item" in a hashed list.  Each entry is a single entity,π        retrievable only as a single entity, with no relation to anyπ        other entry in the hashed list.  This excludes applications thatπ        require browsing, as I have mentioned, but is perfect for symbolπ        tables, dictionaries, and the like.ππQ3.2    This is all pretty new to me.  Give me a practical review.πππA3.2    Okay.  In the hashed list there is no sense of sequence in theπ        classic sense of the concept.  Items are put into buckets basedπ        upon the type of calculation I have already discussed, and ifπ        the bucket is already in use, a new bucket is found according toπ        a set system. Therefore, two similar items in a hashed table mayπ        actually have a physical distance of 500 entries between them.ππ        A practical example:ππ        We have a hash table 7 buckets big, and you want to store threeπ        entries in it, using hashing.  For simplicity, let's just storeπ        the characters A, B, and C, using their ASCII values as keys.π        Their buckets would be:ππ        Item   Formula    Bucketπ        =========================π          A    65 MOD 7     2π          B    66 MOD 7     3π          C    67 MOD 7     4ππ        No collisions have occured here, since this is a simple case.π        Now, let us add just one more item: H.  The first bucket thatπ        H will request is 72 MOD 2, or 2, which is being used by A.π        This is collision.  Now, we must find an empty bucket, and so,π        we apply a common method to the old bucket: we subtract anπ        offset from 2.  The offset is calulated thus:ππ                Offset = TableSize - Bucket, orπ                Offset = 7 -2π                Offset = 5ππ        Okay, now, whenever a collision occurs, we recalculate aπ        position using this formula:ππ                NewPos = OldPos - Offsetπ                NewPos = 2 - 5π                NewPos = -3ππ        In cases where NewPos is less than 0, we then add the table sizeπ        to the interim result:ππ                NewPos = NewPos + TableSize, orπ                NewPos = -3 + 7π                NewPos = 4ππ        We see that this new bucket, 4, is being used by C, and so weπ        have to recalculate the bucket one more time:ππ                NewPos = OldPos - Offset, orπ                NewPos = 4 - 5π                NewPos = -1ππ                NewPos <0 soπ                NewPos = NewPos + TableSize, orπ                NewPos = -1 + 7π                NewPos = 6ππ        We see that 6 is an empty bucket, and therefore, our table nowπ        looks something like this:πππ        Entry   Bucketπ        ==============π                  1 (empty bucket)π         A        2 (no collisions)π         B        3 (no collisions)π         C        4 (no collisions)π                  5 (empty bucket)π         H        6 (arrived at after two collisions)π                  7 (empty bucket)ππ        Now, remember from past explanations that searches are conductedπ        by comparing each entry to the key until an empty bucket isπ        reached. Therefore, to find A in the table, we calculate aπ        bucket of 65 MOD 7, or 2.  We look in bucket 2, and see that ourπ        key of A is the same as the table entry A.  We have thereforeπ        found our entry in one look!  Now, let's look for I.  That's aπ        bit different, since it isn't in the list.  How many looks areπ        needed to tell us that it isn't?  Well 73 MOD 7 is 3, and we seeπ        immediately that bucket 3 is a B, not an I.  We recalculate theπ        next bucket, and get:ππ                Offset = 4π                NewPos = (3 - 4) or -1π                Less than 0, soπ                NewPos = 6ππ        Bucket 6 is occupied by an H, and so we calculate the next bucket:ππ                Offset = 4π                NewPos = (6-4) = 2ππ        Bucket 2 is occupied by an A, and so:ππ                NewPos = (2 - 4)π                NewPos = -2 + 7 = 5ππ        Finally, bucket 5 is empty.  Therefore, since we've arrived atπ        an empty bucket BEFORE arriving at I, we can say that I is notπ        in the list.  How many steps required?  Four.  Quite a bit ofπ        overhead on a short list of 7 entries, but consider a list ofπ        100,000 entries!  Four searches to find an item is fast!ππQ3.3    Okay, how about a real working example of hashing in QuickBASIC?π        Theory is fine for CompSci freaks, but I'm a coffee and pizzaπ        programmer, not an egghead.ππA3.3    I mentioned that one perfect use of hashing is for wordπ        distribution counters.  Here is one from Rich Geldreich that hasπ        been tweaked by me to account for some things that Rich did notπ        know then about hashing table sizes.ππS5.0    WORDHASH.BAS [F210S05.BAS]ππ'WORDHASH.BAS v1.10 By Rich Geldreich 1992π'π'Uses hashing to quickly tally up the frequency of all of the words in aπ'text file. (This program assumes that words are seperated by either tabπ'or space characters. Also, all words are converted to uppercase beforeπ'the search.)π'ππDEFINT A-ZπDECLARE SUB Show.Counts ()πDECLARE SUB Process.Line (A$)πDECLARE SUB UpdateFreq (A$, KeyIndex)πCONST TRUE = -1, FALSE = 0ππDIM SHARED TableSizeππMain:π FileName$ = COMMAND$π CLSπ LOCATE 1, 1π PRINT "WORDHASH.BAS By Rich Geldreich 1992"π OPEN FileName$ FOR INPUT AS #1 LEN = 16384ππ' In Rich's original version, the TableSize was set at 7000.  My versionπ' guesses at how large the table needs to be based on this:ππ' There are 5.5 characters in the average word.  Therefore, divide theπ' text file length by 5.5.  For safety, assume that as many asπ' half of those will be unique.  In normal text, half the words are in theπ' hundred most common list, so this plays it pretty safe!  It will dieπ' if you take a file that is over about 50% unique words, however!  Thisπ' is for NORMAL text files, not word dictionaries, where all entries areπ' unique!π'π'SPLICE IN FROM EARLIER SAMPLE 4.0 IN THIS FAQπ'           VVVVVVVVVVVVVπTableSize = funFirstPrime(LOF(1) * .09)πREDIM SHARED WordTable$(TableSize)πREDIM SHARED Counts(TableSize)πDIM SHARED New.Wordsππ DO UNTIL EOF(1)π     LINE INPUT #1, A$π     Process.Line A$π     N = N + 1π     LOCATE 3, 1: PRINT N; "lines processed,"; New.Words; "words found"π LOOPππSUB Process.Line (A$)ππ    ASEG = SSEG(A$) 'QuickBASIC 4.5 users change this to VARSEG(A$)π    AOFS& = SADD(A$)π    DEF SEG = ASEG + AOFS& \ 16ππ    AAddress = AOFS& AND 15π    Astart = AAddressπ    AEndAddress = AAddress + LEN(A$)ππ    'get a wordπ    GOSUB GetAWordπ    'update the frequency of the word until there aren't any words leftπ    DO WHILE Word$ <> ""π        UpdateFreq Word$, KeyIndexπ        GOSUB GetAWordπ    LOOPππ    EXIT SUBππGetAWord:π    Word$ = ""ππ    'find a characterπ    P = PEEK(AAddress)π    DO WHILE (P = 32 OR P = 9) AND AAddress <> AEndAddressπ        AAddress = AAddress + 1π        P = PEEK(AAddress)π    LOOPππ    'if not at end of string then find a spaceπ    IF AAddress <> AEndAddress THENπ        KeyIndex = 0π        GOSUB UpdateKeyIndexππ        'remember where the character startedπ        WordStart = AAddressππ        AAddress = AAddress + 1π        P = PEEK(AAddress)π        GOSUB UpdateKeyIndexπ        'find the leading spaceπ        DO UNTIL (P = 32 OR P = 9) OR AAddress = AEndAddressπ            AAddress = AAddress + 1π            P = PEEK(AAddress)π            GOSUB UpdateKeyIndexπ        LOOPπ        KeyIndex = KeyIndex - Lππ        'make the wordπ   Word$ = UCASE$(MID$(A$, WordStart - Astart + 1, AAddress - WordStart))ππ    END IFπRETURNππUpdateKeyIndex:π    IF P >= 97 AND P <= 122 THENπ        L = P - 32π        KeyIndex = KeyIndex + Lπ    ELSEπ        L = Pπ        KeyIndex = KeyIndex + Lπ    END IFπRETURNππEND SUBππSUB UpdateFreq (A$, KeyIndex)πSTATIC collisionsπ    'adjust the keyindex so its within the tableπ    KeyIndex = KeyIndex MOD TableSizeπ    'calculate an offset for retriesπ    IF KeyIndex = 0 THENπ        Offset = 1π    ELSEπ        Offset = TableSize - KeyIndexπ    END IFπ    'main loop of hashingπ    DOπ        'is this entry empty?π        IF WordTable$(KeyIndex) = "" THENπ            'add this entry to the hash tableπ            WordTable$(KeyIndex) = A$π            New.Words = New.Words + 1π            IF New.Words = TableSize THENπ                BEEPπ                PRINT : PRINT "Not enough room in word table!"π                ENDπ            END IFπ            EXIT SUBπ        'is this what we're looking for?π        ELSEIF WordTable$(KeyIndex) = A$ THENπ            'increment the frequency of the entryπ            Counts(KeyIndex) = Counts(KeyIndex) + 1π            EXIT SUBπ        'this entry contains a string other than what we're looking for:π        'adjust the KeyIndex and try againπ        ELSEπ            collisions = collisions + 1π            LOCATE 5, 1: PRINT "Collisions: "; collisionsπ            KeyIndex = KeyIndex - Offsetπ            'wrap back the keyindex if it's <0π            IF KeyIndex < 0 THENπ                KeyIndex = KeyIndex + TableSizeπ            END IFπ        END IFπ    LOOPππEND SUBππ=======>8 SAMPLE 5.0 ENDS HERE 8<=========ππ                          END OF QUIK_BAS FAQπUnknown Author(s)              MAKING (QUICK) LIBRARIES       QBFAQ                          Unknown Date           TEXT                   28   1052     MAKEQLB.FAQ   >I  want to put two (or more) libraries in one library so that I can useπ  >procedures from each one. I do not have the original .obj files for theπ  >libraries. I have both the .qlb and .lib forms. Or is ther a better wayπ  >than trying to combine libraries? Any suggestions will be greatlyπ  >appreciated.ππCombining libraries is easy, you don't need the original .objπfiles to do it as long as you've the .LIB files. Here's how:ππ1) Stand alone librariesππLIB new.lib, +old1.lib +old2.lib...., newlib.cat;ππNEWLIB.CAT is an optional textfile listing all the modules andπroutines in NEW.LIB, the combined library you are creating.ππ2) Quick LibrariesππLINK /QU old1.lib old2.lib..., new.qlb,, bqlb45.lib;ππNotice that the component libraries must be .LIB files althoughπthe combined library is a .QLB file. You can't link together twoπor more Quick Libraries with LINK.EXE.ππBQLB45.LIB is a support library supplied with QuickBASIC. If youπhave the PDS then you should use QBXQLB.LIB instead.ππHope this does the trick.πThe ABC Programmer             ARCADE WHEEL OF WEALTH         Like TV Game Show              08-01-95 (00:00)       QB, PDS                238  15623    WEALTH.BAS  '>>> Page 1 of WOW.ZIP begins here. TYPE:BINAA TLEN:11366πDEFINT A-Z:DIM SHARED K,S,B&,Z&:V1 'Created by PostIt! 7.1πSUB V1:OPEN "O",1,"WOW.ZIP",4^6:Z&=11366:?STRING$(50,177);πU"%up()%9%%%I-%1PmyD#W*Z9kDR%%\W%%%/%.%%&j%fqym%SgfxKfb8BKT]enTfOπU"xV.\?FQ>\^-m?VGJjXn-&'\&MO/2I::p3*g'#Y(kc7tFs(g)n(cAK=f_aUXmSmeπU"xn&2ONY,G&G%CCN'bFNl#8r<U8?5urLAZ_$CD$I$8O#Plbq&ior$UEu_lR]4&?*πU"McMG/OShz(f^6tXt=;9_cPO(bVs%OpDgLPMJcpuvHmjUpKR&Tqn*f;:qTj\9/?.πU"u3/[Ncq7sh(h<B$%CeQLRf(UUTB1X/LRIi,iLWt=;X,+*URDpCQNV\;Wlml#NA3πU"Z6T%.hVCQNW<;6m[R<5KS*Eq5.nnL4E*u&S.YU8:8;K,*e1T&,Z(,>3p3bf_kM2πU")<UGcvDhgRhwiv;\mMX?FbATG=afRS/4\g+PqWQg%6kFr_iZ<k0Os574TW'Q>,<πU")U^<n7S$DEN/Z*J;mP%Q:\KA4<9;(=t,Fb$%f4:r_M/qMYgwiTXKl/W*X]'$;3_πU"v8h7x^MgU7^TTdwgtV-$Do^\q+Y+:X-B0ADPkV,V#2HO848b2BgR)kThlHZ82YiπU"'*IH/lNe#-Z_H_k<KlDDmMWIN1:aIMRsP31ruXhC^06Mh;QVFu3Zy$Y#:uU;M<CπU"ZtiilV?)8utdc/Smc1'5L5XZ5tPohf-RR>Y>fT>Kn'f/6E1**b/D%bZhK.=*EEpπU"QzREl%uX$i##q+6IoblG5s-6G]>f%$*EFC/4'd8:gH+;:?CCh]yXhWEB^Wq?RF&πU"VU?-FYxcO-:vO9U.03rFF;ezGNLp5B^ca=Q7<;\Fkt]nAKl8-Z<$r3Nj\A]puH^πU"'V5FXWD\Ck$quwo]R9#x+T-bPoc:o<Qi'6Z(cIa]6D:QKB4.:M&]X#Z(+8.wZS9πU"*jk5]\Dz65jApedV*UcF0xSi_NPB#+c,.)6Z*oVQ50g\AG<foDPXn_UYyJsl,htπU"Nv-AxrwJ4WAg/*mrL7-v8bFqs$42OMuLvegVmZ2]q7SxsFCmAN]]^B:?)0=w0%'πU"')VFF:ILb(L6TI<fU0d>TL8UfT0l,SvR'scT?KHB85P*-9g[T\MPEk#XJ,gv6;/πU"\Yd[EERT0(+ErF:;xrTW:3,,>$/B$FyS[$F(oibdNv=qSB*DvE>:%6724X^*f/oπU"$<Z_h_n3ACp1J'0$GtV'qk1HO-q*]h9E>;C_>Utp2d#FP\ZO1$CTTru;3pilvKDπU"bVbV^\P\ZoBJ0lD67pVK?GMl>h5#Ej+=]4?I)rnm?DBS9/Rk/iXkrVRjN;m8e/4πU"TUA$0W)+XaH8\aEjBl/4TChx#brZF>GjtEg0#Ma;lS5n%&1^wTYlnV*=d]_R)nMπU"gc?lihjXXuL73ws02pK'4RuFegTt)H42_n;-N+](%$jb?[KFD%;M?it_]hVY;.KπU"4UolWu#/a]DhLQuYh\%.z3N^?l#tnHO'5'kvL81tffWr<J0,X%a_A[=bPff.Z4TπU"aDSN5u6RoiBO<+tIICOT_1gtk,OPEN,.3dY'?9'MqU5Eq&U%(^LeOO03[ziM4guπU"o/qAn*dV0X_+jJPPUc=*]9f_z$i,'l+/7DvA?v[wGA\Oh:WmJ:-s4[5c;F1mu,rπU"180.v1Jtc8Acg&zgM;dC*MC_B<Be,>6cD4gRo;N=:NSF>L%DF^AryNNZ=bmj5]hπU"QB0wQnhZ,XbJ4FBB=AGMr5-YnTbPvTD*9I=<r64L8$e,=^9GyPp6<nA_2rJh?1GπU"H^BVs*BJkPTK(EHARI0Z8$;o3\[,TChP>Qs6Q8bOXY0U2%4T;f=1L^H2')>^:EEπU"1*0<DS/lS9;L*eP^F36LGX,OJ02zNC-cib]ulNg,4r\2uRE7oNsEYTAk1g5_&?xπU"Cf&T:0xk_QD3&#*7^VTDcb8[a\&r#ohcZe_08A\%Vlj4StMDNUm^rJk+2&Czg;eπU"4=fodN91U3*H^3hs1;S?2PdK:mMwU=1E%TJAp[svm-s(>(onmM,-6+o2eocQ3K-πU"co5JB3W#G(VJ=T*oIb%Wl+Pg.uz1b(yYag+q;IER$+D_apA7R>2JTm0$#?*Ks*,πU"plBqJ9$gg0t8\pJ#<fw7;8RIADi?v]Ksso73s?CV[#j+tN]n)7on8ELZA%(p(kVπU"%lO5RkZt=$18xV&0\7$23\wh<LJopumHbauQs2>g-eJ]m[^E)Q$QG+E$Tq=E\D7πU"+5APkZJ-Fae,dH*1qV\1y5_$BrTB5qB[>I_hd)HAEg5;3?'p]RQ6,**I/ZFR87pπU"oPran4-6%VSp0g[V_iF$H[e:fDQ7m$fS/NTmiO[me#8:AXUZhIb$95KLMIP9g^SπU"p7ARz1BV9$D?P+Ao\E.oBz./$%:CJtK;FnaMVJuwHYA$KqIP[M7y\S7l&.?uzANπU".1yOVW:BorwYI7FvrJrZg2czVXi$Yr(uc6o1xf5j2C)0;:YSR1n+$jDbxYE;dz9πU"S=#M#8OVTsJZ4?JZ)uYPkCZ&QgfmT#((>9Eg5Y,f0^:z)4NE:p7IJzR,c_nu-KKπU"P1n)i/bRYE=a^V4IvM?HF)Ck#1h%L[fbVhOGjDEf1oV]Sk,#WRr<zuo9d7tY7#KπU"2FRNDIBw5SHOsO'4*$pMMKQKCQAvJB'<Y#;5ZZ3yCA-;BUD/=Xmk(,S4)G^m2HkπU"Pxlaq-4_JkBsNW#eyLPfJ]]QKG\^=$B^.U68ipi7>7)TyggMlMdS.s+m$:AQL#-πU"<.$+'84IUg%-NM;:4Wu_9>I;fh1Sdj+;&'9$'?SUg/17*pk315jv_>+saA_f2>[πU"ul\%tGd6Pk;b?YYVW\;*g+X+LkG:>RjI.wM%KN;m>JOkk,m:<Z-Y+O_skQb<P)BπU"*>*c9O%?q=vL89JJYhhoS'U4j2cgPh<cF(6xI6%nBXw3=;Ck5=3kV(>CFrX*J^3πU"5;1c(K(pz5+U_D2foV+G>N<qWQ(2gxp1iv:L=J>j0]PAkn2IGh^4alb%7>C3q'_πU"IC&l(Z;iuJYVnD/'6#0<lc'w%kbH8VFx-a7;/d].v*:+GtCgW9lb]CY;=Zacf,\πU"c9lj%Dz=wNduqgO,fLZna[]8/3v]3/rc^,)#^3T:5koI,L)PmheULT4^e>hq%dKπU"Jt0H6nepruW5ZR5[>hHw-G7Y]s7YAUU,rhS<$:FcanJs(NQh/ND3:>FVQ_lPC<YπU"MO0Q^r*''9AR,6JjVM&Ygb0%Q*nX4KSAG88jvfBqLH%%'Xe/,U<*]Ohqz4i[1h1πU"A'KSe7Y,MZ#5vsa>yjCnX<b2[/Yoh$CsBl$mpWuiDdf3,Vepvz,EhWBE7au;?7)πU"1<r_-^'uC]4gqtBLpG)bQ9=WC#v-XXFwn,v&TLDCEhSbw_0]#nyP$J0(D1Qdm_(πU"J'U7R5J9Nu.kIT+c)z>Uq^.rUU8+g.w-tna.5Ah(G?18<9>XlDPV(tBZpU6_s6GπU"[EpG[E4i95DFgE4rcWnV_G_W&8Ek='O'p^i'Gx-?X$_K#U(Q&x7E(%Iy-igv%[lπU"PzfLAQB50FsN=pj3As>-]J:Dt%TiW37XY3XT$#H*=eI;a[Mi:Z'4?9:[UuJA<-PπU"YBZ4-1k>u7NvYo^f&[r0[u.y%eE1L#g0XJv)]SusSprS;+k0X.UyWW[KUJxL:n_πU";4H^FRr[\R.SV]o*tp^M4XcDaRDr%<KIFW*k4IQC82%>_;rtRXbkZ<fVAhTW0J-πU"?m8Z3Qubzo7c;Z-bxj016UT>I^W=a$.FcQLD_Pb[sC=FnRs)qu32hE+;Q+$/=TzπU"v$BTU=Ij5Zyn3mf/G*#_;bmGkk/O8j(79n?f&#E7*Aq%'eI^tYjPr:#kVk17U]xπU"3W(UW7n)$[hNj<=cqpu=v9AQ4=GVo2BPpJ,1*b'XI=A6&'6JN+H)4>6=J>],t7>πU"*)W73OiV*1*_h.d(*Z?R4Sh:3/sT54N]Nv/oTi&Enp.bjWssx6WGgiu-SiCiWvyπU"v(V38qRlRSg*+NKJPLsTh*u^a)dfU7x6XFC9KtmQ9PHapk7]VR)aU_3&lptBBUbπU"b#Ek(5D4aF5x+qG;J10p]7paMIzW/,cHf56.cq#:#\Zx3xUOoS+*.0-8l.#D8B^πU"NNWy2f%RAwi$uJOOj#*kV3wvsjc#d=goRC1c/iHQ2TVsSymHwt]kIfZ*q'D]M0HπU"ncWJY6Os%c^uI_C\8oUmjqR&:SGx>/+IwGd]G)^o%fGIOO(9\wf;_[>[FJ^xV]-πU"5\cM)k4<$a5x<nR)^8$)G3S7Zah%'bukI'KX4viN,f#Ie_mPqg8+q*H'<fB5#:mπU"920^tpm)xS*Li^eW=X06('g=a)GM#.63Q,=63OaM_x+;9j\nir7W2Q,%lat%nT_πU"o6go/3=51\L]3*4W$o+iRc];0O0QvDI)5-:vIm19>w\>miu(ti$da#gPWo\Ld\oπU"K*N+0j#5N#N.GNHq\Z,'QT#>Cf+5W'?=a<8+.U^M)OY3UN(2_G]R(YqUeN>k:,fπU"I0IR(.>d2'^55U$uS'&WbQw(Sv8uI/9ZO3#8[21YsqWC/%/T7k\/y*9zN.GTM?1πU"NVM-q1,2fhU+2s<azCYVE?[oh>5Q=JPykT?+7K/FP#nZ;3Wz%j(qZ$3ql/L55.'πU"RjEEPuA(1])8>ZuhYE]B3mW5Tbbj\tI8oRfdSFedQq(zG;RQ7&YxY7%C4UdZOdMπU"Pe_z]1LRBR&G\l3TprmWM;2b4hbkX4g5]p-n='VSK*5-1rc(+H$Oyrnl>#'9J&EπU"8b2i4L(nyv8>E6wQ$i1^J3o3?t'krmxYWa_XGo2Xmb1$H6WS;v%eqvWJ:]\J]X*πU"U\$Xg=OX*]Ts*p6k7*0]wkkUVP?xbh?NQLZXW]G5=Eq-,Gf]qL$Fk/hp$qRO,G?πU"mmhEt<LuKm;d(/9rDxIFS<Yi<rZc0;d(QAD'C]>VF_SoGC)BICNe^xk>e;0w4r_πU"*KbKdK76'?&iOsUW>p^\(ORw97D+i%;rGKT?..6]9lPKd8KRZb,e'G9jI]'?0U/πU"f=f9+jpX]_8_Nehx:T0Lr9x5l%]$?/*MJIlj/\nNE\bI,5swDEfZlRe%mJaa$wuπU"?Cv/gX4[:Y-\tZ.0cbLm;02=l0Z_:2':W^F*IcYb\&(T$WFxjTf0H>P^msLq+9hπU"eDvk)Dv>,m\Nl#>bc2NI3y]V\i%O#YWU.-Jw-]\-U4gp[\^h1I+s2O<cw1TNPCwπU"mGz^Q)[0<9GzOk-Dz5.$TaC.gOq;kwNCn(W*,gmJet-%&_oH,%3^XKz)3CFz?U6πU">DabgF5fgqs4=_HNEG)YXTA_OZxR?P^6#-6Jm,:?zx_<t;&KvI^kDtY_ASUG)$?πU"UfYO.p/yc0aowQMGyC3RvT?R21CG,I5(KYBVPHgRrkGYJxX>wLHgg8^Zq&E;]D]πU"WEX1Jhq>$i&,iq[zW71nqF>jRuokRTBJKpS>ZF=0tKk:J^8)6XwOOX_;+GX/>])πU"0K7d<O.bc)Gj=r1aC1J%o5+(J[R8f\p\*2g^.kM[zx[,#HiGT$?Z;Jj].8MktL;πU"46$)_n6P>1K%'0,XW*woo*;_nOfqpT>CW>9O(,WB7xZ3lKP?>0P1PQFBU^wGefwπU"[EXGf*9G;FBdo0R%%gHGv0M6za1J6;8bgz2ZgP95TpnD*hmj[&FA:O>KSkz?%V*πU"LG0xod.Wb<f)dddztk-WEi*0I4y>'S?CA]qGILO0sud\D8kZ2lTwwk:;%wvr_lWπU"3$.My^gri6FHQ3bd60)Atr_lW7c.7y^+r_rZQ\-:w$ke_L,pEac9lobtcNb4bp#πU"9?76>Pg0s$p^b<H]Wj]dxzgVsTO[jRub?>,QTL5ht][6'nzOGFKk:K?[MrA#<;FπU"pHBXJ6C.mzK^s)8ZFQC>sZg;_q=4gbWf+h*jzg3;\+Xs2K#OFxn>BDUo\xg-9WzπU"^sqIX3*bjrz\XS%g&2hJIdtbYiKK>ZMMt,lNxu=g+QU6TJw4cM#p[jMT6%HJP9bπU"g\8Q8ESSJQkZi9;Yk703bS8qgIiT-R)H*#0dlQ=FWOc0.1NhS<by/%EukV.P0SBπU"jUt>t?6:o:<cwb\v]5Xzl&]ReJ]**mTJW8u7q*#[M>FfA&k_o2f$SbHNajmn06RπU"uH\-biR^t#<#XfKkMkt*//=JeF;-%oc\T=mK,PJEFFC^ME+iJ>$n?eMEMmjsWx[πU"BW3,3a0Y>*2%D(W,DVWqA27F\\+GV7sc2$R#J'DroFPGAl:)MrE5rsSUgk$<*LGπU"M(<de^>#[U=^)YkX):PE%K;$g+1-%)mG)%KSV9+ou(WMsN4QfI[K#yjc\-mhXPoπU"xc,k%4O/ZU^ZmMKK+\N)h<>w#m9\N#n#c<N<5dai7(TEg8aoiI1IDj=-f:;$hDGπU"tJHXAa1rb]3>l>sN&'nUaCFQu4MZxX;oU$#,qY'ba3<^8DPP$R9u$K_#Sj;fb6IπU":<]iF:8PIde2AWp<mGbk>1]+ArrI\PBk;uhA>\[c(^6UIHo<)8:b_>;M(E?K=5eπU"&b,mm35^75GxJp#uA+QIup+c*JSa=d'Gvil+_[LV\H,C.hQ]JZ]DcFWE0TC&OS;πU"NfYY(2cO)vcG#9JgqQ*vQ%*B;s']=qvtI\RsxKwc\3/[HbZXZ%[RL&BP$(v]BM4πU">jYAI5Dgi%pL4\h$\kZq(-[fAa'EA7Cka)?D'8.%8wVt%wUtw4VHaVTbSZAgFfQπU"w:OTjP]C=2ghUDn=SGlZVek=a7YP0hoVs=[Zp<.q1\YHqUk&&$,COcxxR#j&gOWπU"KIP^=]R\UU:MIL*2&qmSfiLs]$kjsDJT=ts[Q>QVQE]WHb.=9]efZK;At*nXK6-πU"RD6,9&u'FBN*GBuh\hA\3*WjN&z(*8lTu\<be-L/:u_0iJUdbULN8J9\SXs9DX<πU":\%U?7+,yi[;M9o0f/*]RoINL]^^nbFdQU)_ML#<$%[G%q^Q0*202316=Wow<-+πU"GftWMYCOS0:.^_1fJG3U>8PHIvb4Ul#J'^(Op;Nkl=)q5x.7g.S0&Ub;4BpIl=TπU"Q6/xf1BdpwFN;mq&+yIF8O[<iP5\t0H#uC0am)\V-cPd4UOa2]P8x4.L4BSbg4mπU"CXdMLzxIA9gy^\C)Q=p%6*UBU,PEcewd?sdpwl=<Oh6THzVxl%2b%''Awj\hV^#πU"VsuncdH=k.u<p/=U-WYp2C(S&f-LRC/#krsEWz,lhTz0)5WaI:io#YOApfP%s6VπU":;7csJg7Y)BWhq:)Q0#N)n=-GhbWis9\JCtWI8sU&k..kCL1-3s_7:)nX&Y$.gtπU"6+W=f&iuAu[tsWAE6r0S6SmzP8w.<S<Tbm2>MY>sO<JwcV'WJSW%WwOB,<w:ZvPπU"4;HH]+B1dxbee:d'?KaK\JpvH)t93M<%5/ytQnibM#n8cxU/EOOs?dN[95>;/h_πU"&UUm\ph.$.(yPFAJz7-OElHB=EvPW_A*-dSKZF&)^$M'?d#cgRnQrDikC+'%\-oπU"itq5du[kc<;DvT#kKmUwqvjTj'(>_V3md(FK[B6L*g0'wJc8W:rZVmb2HIr\jE%πU"agJh'(CoNX)b']w\tkcDZ'uD)1$^IZOr42MiGNBX8W7*>_3'rK0qc?JFB&kiMZIπU"4Chh'IU)wAq,KHE<Gh5^7's;8pN&Y>SmqgJjX;5I^e]H2NC\*jJocb^lbD+&uzqπU"\so4fw[M8KJ1xZa.DfbPR4#BZyMS<wW3A1mva6B]?)Y/_ue9&di(Np;MortB.f9πU"&EN';L6ujvT\c8lX,W63$+.'3CZ?/+HxY6]l[lkVm3fZ23)pACbVjfq]10YUwL\πU"1>1;5WtUjapAE[mVklw5Z0_)PF]3nm2.v2BpBaX0_C]j7eJYls$gc2VdYN=q]ZoπU"RBh)\l48dFLl;lSSF_6W,va#U#&aYO-[2NrN>U?U-Zu$9g=na3++m%C?R<W1q(XπU"B\'WIZmzPUgo//Da$(Lq;)T^+&9M1mB&6$kfsC>JyB4#Pe=Q+o6;jYMFUC8+rAfπU"=UJKV4=iD%;Q#5^[.?eX=2TKVc.tidiazHcGBQ'sc*GS<KRwwh9pLF3L0Ua(0HuπU"4Me)-kGC:gw7M->;pxc=d^ddTr_W-Nrw9ld]MS;fc*CRbAi1(:2jt4;5wbh)tfMπU"JszL#ta/nksIj'XGf&Cj49UIv_a7in%<R\[klSZC;'MbS?F/rBH>B9J<K?9cgsrπU"$77<fJiiGf[sL:X#^o4,eRC<Dy$N?sW&7\cM9aI%G2V2rXBp6EI#O0>G.\DI4ONπU"Kdze3+kVpIH1l.f+d(XebV(FN.d+*]DRO2S4R0sW]%D9q=(B.Q-UYaG*JM&PD79πU"E.R/03a$'$91N[s9b258]Jz5be2yr*hLxeqr#0j8f2irjk+fka2sF#]FVJJV]:EπU"RvP3W^_u/\$>mYOA#fhE.?Dqxz_'n*Y8_t[^PmG;.R(N3,)9n:O?APzfxsf..z-πU"l<'NI2kCLU'[otGDbeDxm/x[CakrvNrJxEa+1%Wr:N:L=oDs3o;qzWs/A/S*f6eπU"$eubDf7)z3Lw<[1F335SD#=(O8T(QX\l'rf673.\=4Dwa.HK,XSBM/R0P38,E3OπU"\feNm*]cRc]:RHHf;Vi#YcW6AIorJ7n2i6p\IE_O1+36OUHUnl:GXf:tsG-JP5RπU":SP(80Ya\d<q3Qq%+,\%suutB[^#HYl$bM.:t>qM[&ArCN$>FkBM:P<KQUh3R*hπU"W+4\nh-kl9XQ&;=lY0bO,27]Y>7s'3/K#e'T0/J',z\U%Tt/j:9NBKxmKuBV2f&πU"r:&5noM07sfXDRTFa7$w)t$51#?,D9Lu6sGT2aQG</Tw$5PZ5j:CJu7/YVnrQZgπU"MQuH,I#[*dtgi7L,Z^H_erW7mY=NW&&%K*u_.AJ1.L/irRJYS>q</E<OzZ5H<IZπU"trDE5#0hR9Bh&*Ff_Xa/8YN'cfX.R4liDjVehge6l^EJP_gM62J17fIII%W=^R(πU"QU5ume8S/u2N+'x3d(58foD^t:L-oH/az7+s2u;UcIO0T[/o;/x6r]GhTpWTc'QπU"0&srO0r86[<yw7nD*;)k%P>e6Wl'SQZ2\\eQT-Hj*C>jYi>,Q('?iRhMj9oGVmwπU"bElmX/jiPdUl9Lckk67w=)01vGqr8ecvNz&Re:VH5F*+*?=wXec\cBBuR'blVuWπU"*(E;CZHgW:OO2PxkGt6(KA^JPriftK^E<R20t#d08[:Z,bkb)/H6agHUI34b]3lπU"ROC4aqHXQM3g]-48;BU23V4:]HG:b3\J\0b#/fS0GNl)[]HdQgKM*5Fe-,s(j>oπU"^<IF_0)xHwfj04amEpGCr5/SBT0C\e.Gg.G$mBX+=Mp&%Dso$j*As&r7f:*+;L:πU"KO:Bae<qC\.B?8pR&t_xv>Z(HGU)7Dc:2HU;=M[*1fx7*VtU?;a,yT2Rp16Q4stπU"A[O4PjkpylI*Y+?>Z61mUCL*?(/9nT+XSkU%$3jh0m]za>z5/Vpo>:InF,i3)']πU"bNStV4d?aiV]NcbxU1eqtc.u>T(&<Zb/oc:Nm.MY&wEKr%*^^eq<A3:J,j)4yj\πU"C78JHWJ9PMvI+M(?gFE1w]W'M(9htM/]teV)YB'k92tIMYte+%imYS^vkh\%6jPπU"YR3vEPTJt/o_a1fj=\1AS?gK7;b7+Ug(rtUN5wfQol%nh*i>P:rI7?x:FEb=;D^πU"$=7b^^C-]U0=3YfeQ*bzHMqW:I\VRed:JYo9egiLSv8PRDOM9KAw0rVAP6?G73OπU":ziA&]P?*SHTp'aD.kQ#eJLLL96ZJcey(I<C1f]%6-v.OX+g615.J*cDK-*K%r4πU"b9W=eoFHAdaGMSZEZe3nbkSp9k$dl'?kf1gnmP82imE%0s%X&P)+=)ir$3w^<.;πU"50,cFSCD_OZS#c4'jNL_'DIP[O74Hi6CwgA#ge1gx0H#);8zk/+*bN4aGM4T_FpπU"n;f.756mn;?Rar7rZdtqlBMhmv6x1$\':AA1GU'4(G[?vL-OYQ9Gku?rUh.<h+<πU"JeS4<bhuZ<>1W,qvh96<M#?$NqsnC[qowJlcZ)LnvUa_\Fu5grr'wCFY-bOk.asπU"7pQYXM9W0*5Wo294y2ydUQ&558Mi/]R:j5)ka*oG'pY=nT%D9%BNzt$XLD3t08&πU"->3AWvwK,/JaXhdSbb3%#QgN0q?#7VR-/fk;r_o'T+/&>nP=9>WJ2'C%<;s>[\PπU"]r0U,*_mw-S*6pD)um-23_&;4/jL0<u;%j9GY><:#sQ1GaAAf%/]T[7Qa=ES<B+πU"g:)(OFdpn_N0++(skQ-CA.o73jE$-r$7x(&JeO[kW4ZGJzNaIqy/1?W'TQVQ)m1πU"Y*'W%g5%_1<:\RGIO&XnP&dgy0lwKI*VSgPDFk'x%up%()9%%%%-%3;LDCrT-b6πU"%*&%%%l'%%%-%%%%hqzj%SifyD4$fA'<E1j<pmjBc-d>3'C-G(.2mx5V<Bwb19+πU"^p7#[5dQin$Gh,f:;7gk3SXygo'hfkg9Aqo0#A,Q7GQ[vQ;kOYbsXq$f2UX<wE&πU"yRNfh.f-75dtP&NN0oPPNF>'Fs789[+]QN#9dBx^cUW:M9OKT]$?HkR9<9[A)+5πU"V6WHoRYTQTwExlfX>G+o]B+&vceNmAs&o_MMcOX/h(2DCBXe=UVCYwwpBS4fCFmπU"t9?rBmK0Gel9-UiGeU5KTb\h?gTboja-I<LvaOlF[Ow_niakD/f'Gc-\62,L.coπU"Xdr5g..t4elJnV7EM,=uhKgPJVi1WHpp=ct%#up(%)9%%%%-%(A/FCCoF41R[%%πU"%Q%&%%,%%%%g%KfSiIfyD^:fE<UR-ipMNHF/f(PCpQ5;j9VhxSjs]uLN/SbQU5:πU"*Wr?W_rhs3UKL:*CoFPF:.AbG&O^U>n,gvig(yIVYthiB,JoAm8p&hb/-TtsS/MπU"M_.[HjSI.B'HnI3;)Cd&j$/<f&*1>'VRNOf;MyM83t?;0Mr7*E\+kHgHYVDE8d2πU"djwk?HW]%%re_Qs)]k;Z;L%C#tZT$6v^gq]Z0o8:6R#M[cTz$8rC^X_\7.L_:g2πU"%1o#zL1n*_/N6gu;0Z=XD)KDI5]eH(k]pXN-GMTu%p()9%%%%-#%kjLCCCjW+:aπU"%%%%g'%%%.%%%%vzt%yjSi.fyLv1f=SUa15Hj>V2ny2xLQ&c,jS=[zU#jWwfMu*πU"N%go[t>L\qG5urWJF5M-Rj_%%x11R>P,StMLt,i&=/oq5b<dC>[n9i4Ro:w,qF-πU"0^*MoYDPU;L.KN_2c,gpX1vmMvG+rxrsP*UK,JKd)?*0Fpe,>BJQ.hyeR,O4XkeπU"KPFc11wl1E/XW7Wd2Z^y5A3k2Q4j4i=_=%z;<$-sMkx=r];Uq850RAFL-jXH^7ZπU"jjq%oFAPRhc]KIXPolxh\E$G*ZAp'V9$zw6=BD'fQPv+LedAmH98UB[tyPR',<XπU"up%()9%%%%-%/KjLC0Bsnd&p(%%'#0%%%/%%%%umwf%xjSiIfyT%2*az]O1vvY+πU"baT0)gi*-FQ9:2LVMSj6n(3IpfaTN+rt0#OId#]X3wpn-7T<QIUX4wt*XJ3Yd$>πU"2u&29A:PP\b*7.4)BxzttNhm+>OF9]F?c43fk(=cIivM;?:,hbe/(3h]dfe,v\7πU"25b#f.-Zk=kaAp^A3Wp<JrNMMcfihX^Bg%$q)aXf]7J)/w)=?V*=F4mKVB;W(XjπU"qe9NtnL;;Y&b(D&Et=6&<i(+SVTa31p)][A>aXkh?R7UWEax=QgIe?5Yb,'2L+.πU"o5<&r)A?r6c\sq3:=:Z)F/N#f&.HvEp/VP(j$_;.TsfGvum9q;bBH)e1)VTlw&YπU"lk^,<b^'X$,J\UBaGJd/TX8c71$sPh?.\3Q&)??nAiX&.t=a%i4+53'khQJ;Y=_πU"i(9^a\EEtK<-HHvKSGFKF+h[$je?A>CFfx,)+nkC*Fb\4>Yc)A=B1W[MRp[L3>:πU":9nUrzo%4N2qx2--%M6O1*\/3b/N0Cz(+RDTDJp$:pg5v,\>Q?tt#BOUo_N,RxkπU"0FYIBi^mjdA;0X[].A^cOahk+OPHR.M_#qr#l6WvVC4x=l%=)d<1't%?Z<7+\KVπU"a&XBcIFiGb%VHkC0B'J3rc1TLvoFEvqXl;hM?%P-yYJsouR,pG>+>.'?M&>'#iNπU"WPbxPqBm]/T.<'Krc-^]h9ut2H7V4'Zu%U(V_h<po&7$5rAb8RKD-*N.w=yP1q.πU"Q3'atf/v#])m$cH2iEF:Oiq,p8mc'bhaEk.Z$iSvGW4[r$1P4EBfh;zi2ep,GN9πU"l7JN,lmc_tz9abiT&dB5A'Mc=uyQ8kR.mACXfd(/00+YoFjlX)S.hlh:r;)D+sJπU"+SYa[0Q\ptu)takFV98VT9[ah$i9SZ^h&uQZYY9v6K?w-.?NiSKT6zF6JHZAoZ#πU"Rc*bSNaWf>TFgXdK-YiLS9;_\wpofQ^9*.#&vH<]MPJ^Tg/*]i?qATQNq]-9KwNπU"LYo&2rVYrGH\;g,\&c?g(dM863T7>O?1<PmsQO$CT]D(R<MjcR_%sR'd;?saH_jπU"b+GQ\z'q:,hYO=#l[F5_v$lvK&kD964Vf<PY*o<77k>TX,G\H9KEd.]VXog1\3aπU",^':bKoAK.b&P2a$Ee.x;briiYL:;sNunWC:L(G>/+IcX&Ab.Nb\UiM5$):/=4TπU"TDfK\gG/)8+zrdu%p()9%%%%-I%gL?mC8<H(#=%%%%-&%%%.%%%%uqf%hjSi[fyπU"X^<^An21-XSxh-pM'D]p/]pc]:WP]aawMcQQzYZ(8.GW8DWufa\]7?9[-\1_$saπU"^35MXA[Zys5]hes2_qs5VsT],Is*8$Kt5_Za\\YdpC,.M^rnZbQ8#A[S5\AsXQLπU"H\,F]M(4,N%%up()%9%%%#-%(/%FCed%t1h%7%%?%%%%.%%%%xq%fslS%ifyXlZπU"^AnI2-XS[x//GepFm'd/&m'0aw'Nm*Ein6pp#ILoDWVqvn4'Yr'(r3'fv$o*;1qπEND SUBπSUB V2πU"nV_r1;QhZC>]77=&9%up%()9%%%%-%34K?C%3bTe''%%%&/'%%%.%%%%ymns%lSπU"if1y\$V(3RU1^jFIg*Yx#h&J(L=f)?aM[Vybx(n9=_IyR3Xk2rN>Qh$I:p#i,7(πU"ctlJ%m(];5l7Vd70%)LNiZr)-6\$l(ce*s<*Okm=wS?tCiYxPAZrM45c7kc%xC0πU"o0fw$UPv9Y#*dEGF/kt;HtY<J-,j&7c.b2z_sP<))ccM9IaJ*D-SJ;+cRuR?2hfπU"(%cA?JV_6/Zw9bQ>Cv$B]Ui5o(=d9xmWu%p()9%%%%-.%'/FXCF.r('*%%+%%%%πU"%%,%%%%xKw%SifyXX_^ABn2-X&Sx/F-w7/Cq]MW::/]:e3'jNuM_:?WMQJw>4%3πU")yZCDL&H:R6w4?AE)3cEEz:-Bn0d.2A=u(HPLuR<JNsl:TN=V=X4?%PBV?=PJ4&πU",F%u%p()9%%%%-#%ZjL4C9Db%^g%%+%?%%%%1%%%%rjl(f&tw%iSifmyXZ^,An2πU"-)XSx/Of'M]Ym::]tMG'a2A'xU5&8_EmtDx9=uHY5)qCMMFMqlG$3Gk2f35xWuRπU"XVH=XCJ4,fr%u%p()9%%%%-.%(/FjC5QY)_j%%%%k&%%%/%%%%ujt%uqjS#ifyLπU"8_V'(#F1iJ=IgYO?V/bBEiQ\/<(OF<9$dBL.w[YGM$9;8tm#oNj?CJd5>2#o)?PπU"])QDa,1n8OX/5feTOMJa5\c'IG:XFUA*#x#[yDozZgtx)<B=-1,)nWl&=^H55)GπU"8j]ZFa*rr^m.k^4YLak2+ihtr?F:Ej3up8ql$iJ*xWhAPf2WH-$$4'e8.3FqyTkπU"#,Uxup%&'9%%9%%%I-%1PmyD#W*Z9kDR%%\W%%%/%%%%%%%%%&%%E%%%%%%%%&&πU"jfq%ymSg%fxup%&'9%%9%%%R-%;LSDCT--b6*&%%%l'%%%-%%%%%%%%%&%%E%%%πU"&=D%%%hqzj%Sify%up&'%9%9%%%%-%((/FCbCF41'R%%%'Q&%%%,%%%%%%%%%&%πU"E%.%%hE%%%gK%fSif%yup&%'9%9%%%%-#%kjLCCCjW+:a%%%%g'%%%.%%%%%%%%πU"%&%E#%%%f%F%%v%ztyj%Sify%up&'%9%9%%%%-%/KjLC0Bsnd&p(%%'#0%%%/%%πU"%%%%%%%&%E%.%%uG%%%um%wfxj%Sify%up&'%9%9%%%%-%1gL?C=8<H#&=%%%%-πU"&%%%.%%%%%%%%%&%E%.%%>K%%%uq%fhjS%ifyu%p&'9%%9%%%%-%(&/FCe%dt1hπU"[%%%?%%%%.%%%%%%%%%&%%E%%%%)L%%%xqf%slSi%fyup%&'9%%9%%%R-%4K&?CπU"3b7Te'%.%%/'%%%.%%%%%%%%%&%%E%%%&=L%%%ymns%lSif%yup&%'9%9%%%%-.πU"%'/FXCF.r('*%%+%%%%%%,%%%%%%%%%&%E%%%%h%M%%x%KwSi%fyup%&'9%%9%%πU"%%-%ZjSLC9D%b^g%7%%?%%%%1%%%%%%%%%&%%E%%%'<M%%%rjlf&&twi%Sify%uπU"p&'%9%9%%%%-%((/FCW5QY_&j%%%%k&%%%/%%%%%%%%%&%E%%%%TN%%%uj%tuqjπU"%Sify%up*+%%%%%%0%0%&-'%%'kN%%%%%πEND SUBπV2πCLOSE:IF S=53AND B&=Z&THEN?" :) Ok!"ELSE?" :( Bad!πSUB U(A$):FOR A=1TO LEN(A$):C=ASC(MID$(A$,A))-37:IF C<0THEN C=91+C*32πIF K<4THEN K=C+243ELSE?#1,CHR$(C+(K MOD 3)*86);:K=K\3:B&=B&+1πS=(S+C)AND 255:NEXT:LOCATE,1:?STRING$(B&*50\Z&,219);:END SUBπ'>>> Page 1 of WOW.ZIP ends here. Last page. TCHK:53πThe ABC Programmer             EGA CONNECT FOUR               EGA,CONNECT,FOUR               09-09-95 (09:29)       QB, QBasic, PDS        308  8602     CONNECT4.BAS'===================================================π' EGA CONNECT FOUR by William Yu  (09-09-95)π' Yes!  I can document!  Not very well though.π' I took two hours programming this, and I bet Iπ' used almost a third of it trying to document it.π'π' INSTRUCTIONS For Game Play:π'   Object of the game is to connect your colouredπ'   chips four in a row, horizontally, vertically orπ'   diagonally before the other person does.π'π' MODIFICATIONS To Make:π'   Make the computer thinkπ'   You can change the grid size to any dimensionπ'   Better intro and ending screensπ'   Better Game Play, with commandsπ'   Multiple games are possibleπ'   Save/Continue played gamesπ'π' Alright, so I haven't added computer difficulty.π' That's up to you, I programmed this for twoπ' players.  You can probably add modem features toπ' play head-to-head via modem.π'π' FOR MODEM PLAY:π'   All that needs to be sent are X values via modemπ'   You can replace/modify ComputerTurn to wait forπ'   the modem to send something and call theπ'   DropChip subroutine to validate it.π'===================================================ππDEFINT A-ZπDECLARE SUB DrawGrid ()πDECLARE SUB DrawChip (X%, ChipColor%)πDECLARE SUB EraseChip (X%)πDECLARE SUB DropChip (X%, ChipColor%, Valid%)πDECLARE SUB SwitchTurn (X%, ChipColor%, ChipColor2%)πDECLARE SUB CheckForWin (Row%, Col%, ChipColor%)πDECLARE SUB WhoWon (ChipColor%)πDECLARE SUB ComputerTurn (ChipColor%, ChipColor2%)ππDIM SHARED Grid(8, 8)' Do not change unless you know what you're doingπCONST True = 1       ' Define ConstantsπCONST False = 0πCONST Computer = 12  ' Define Colors for Computer/UserπCONST User = 9       ' Computer = Red / User = Blueπ                     ' Computer <> UserπCONST Player = 1     ' One or Two Playersπ                     ' If two players then Player Two = ComputerπCONST Level = 0      ' Level of difficulty against computerπ                     ' 0 = Moronicπ                     ' 1 = Easy          Please implementπ                     ' 2 = Normal        computer difficultyπ                     ' 3 = Hardπ                     ' 4 = Really HardπSCREEN 7, 0, 0, 0    ' Change to other screen modes if desiredππDrawGrid             ' Call DrawGrid Subroutine (Draws Playing Field)πππGoesFirst = True     ' User goes first (Change to False to go second)ππIF GoesFirst THENπ  ChipColor = User          ' Using two variables for swapping laterπ  ChipColor2 = ComputerπELSEπ  ChipColor = Computerπ  ChipColor2 = Userπ  ComputerTurn ChipColor, ChipColor2πEND IFππX = 144              ' X value changes ± 28π                     ' Leftend value  = 60π                     ' Rightend value = 256πDrops = 0            ' Setup Counter  (Max of 64 Drops before grid is filled)ππDOπ  IF Drops = 64 THEN GOTO TieBreakπ  DrawChip X, ChipColorπ  DOπ    Key$ = INKEY$π  LOOP UNTIL Key$ <> ""ππ  SELECT CASE Key$π    CASE CHR$(0) + "M"          ' User Pressed RIGHT ARROWπ      EraseChip Xπ      IF X < 256 THEN           ' Make sure it's not end of gridπ        X = X + 28π      ELSE                      ' Else go back to beginningπ        X = 60π      END IFπ    CASE CHR$(0) + "K"          ' User Pressed LEFT ARROWπ      EraseChip Xπ      IF X > 60 THEN            ' Make sure it's not at beginning of gridπ        X = X - 28π      ELSE                      ' Else go to the end of the gridπ        X = 256π      END IFπ    CASE CHR$(0) + "P", CHR$(13)    ' User Pressed ENTER or DOWNπ      DropChip X, ChipColor, Valid  ' Drop the Chipπ      IF Valid = True THEN          ' Valid Dropπ        SwitchTurn X, ChipColor, ChipColor2π        Drops = Drops + 1           ' Increase counterπ        Valid = Falseπ        IF Player = 1 AND Drops <> 64 THEN ComputerTurn ChipColor, ChipColor2π      END IFπ    CASE CHR$(27)               ' User Pressed ESC  (Quit Program)π      GOTO ProgramENDπ  END SELECTππLOOPππTieBreak:π  LOCATE 1, 1: COLOR 15: PRINT "It's a tie!"ππProgramEND:π  ENDππSUB CheckForWin (Row, Col, ChipColor)ππ'              <--- Column --->π'              1 2 3 4 5 6 7 8  XYπ'              ----------------+π'              o o o o o o o o | 1π'              o o o o o o o o | 2π'              o o o o o o o o | 3π'              o o o o o o o o | 4π'  Start to -> o o o o o o o o | 5π'   Check      o o o o o o o o | 6π'    Down      o o o o o o o o | 7π'              o o o o o o o o | 8π'π' Here's what is checked first:π'π'   HORIZONTAL then VERTICAL then DIAGONALπ'π' You can change the order if you wish.ππConnect = 1ππFOR C = Col - 1 TO Col - 3 STEP -1π  IF C = 0 THEN EXIT FORπ  IF Grid(C, Row) = ChipColor THEN Connect = Connect + 1 ELSE EXIT FORπNEXT CπIF Connect = 4 THEN WhoWon ChipColorπFOR C = Col + 1 TO Col + 3π  IF C = 9 THEN EXIT FORπ  IF Grid(C, Row) = ChipColor THEN Connect = Connect + 1 ELSE EXIT FORπNEXT CπIF Connect = 4 THEN WhoWon ChipColor ELSE Connect = 1ππ' Check Vertical, only if dropped chip is high enough to count downwardsπ' If not, forget checkingππIF Row < 6 THENπ  FOR C = Row + 1 TO Row + 3π    IF Grid(Col, C) = ChipColor THEN Connect = Connect + 1 ELSE EXIT FORπ  NEXT CπEND IFπIF Connect = 4 THEN WhoWon ChipColor ELSE Connect = 1πππ' Diagonal Check (Left Up/Down)ππBackRow = RowπFOR C = Col - 1 TO Col - 3 STEP -1π  IF C = 0 THEN EXIT FORπ  IF Row = 1 THEN EXIT FORπ  Row = Row - 1π  IF Grid(C, Row) = ChipColor THEN Connect = Connect + 1 ELSE EXIT FORπNEXT CπIF Connect = 4 THEN WhoWon ChipColorπRow = BackRowπFOR C = Col + 1 TO Col + 3π  IF C = 9 THEN EXIT FORπ  IF Row = 8 THEN EXIT FORπ  Row = Row + 1π  IF Grid(C, Row) = ChipColor THEN Connect = Connect + 1 ELSE EXIT FORπNEXT CπIF Connect = 4 THEN WhoWon ChipColor ELSE Connect = 1πππ' Diagonal Check (Right Up/Down)ππRow = BackRowπFOR C = Col + 1 TO Col + 3π  IF C = 9 THEN EXIT FORπ  IF Row = 1 THEN EXIT FORπ  Row = Row - 1π  IF Grid(C, Row) = ChipColor THEN Connect = Connect + 1 ELSE EXIT FORπNEXT CπIF Connect = 4 THEN WhoWon ChipColorπRow = BackRowπFOR C = Col - 1 TO Col - 3 STEP -1π  IF C = 0 THEN EXIT FORπ  IF Row = 8 THEN EXIT FORπ  Row = Row + 1π  IF Grid(C, Row) = ChipColor THEN Connect = Connect + 1 ELSE EXIT FORπNEXT CπIF Connect = 4 THEN WhoWon ChipColor ELSE Connect = 1ππEND SUBππSUB ComputerTurn (ChipColor, ChipColor2)ππSELECT CASE Levelπ  CASE 0π    DOπ      RANDOMIZE TIMERπ      Col = INT(RND * 8) + 1π      X = 60 + ((Col - 1) * 28)π      DropChip X, ChipColor, Validπ    LOOP UNTIL Valid = Trueπ  CASE 1π  CASE 2π  CASE 3π  CASE 4πEND SELECTππSwitchTurn X, ChipColor, ChipColor2ππEND SUBππSUB DrawChip (X, ChipColor)ππ  CIRCLE (X, 7), 8, ChipColorπ  PAINT (X, 7), ChipColorππEND SUBππSUB DrawGridππLINE (45, 20)-(270, 180), 14, BFπLINE (51, 17)-(275, 17), 14πLINE (275, 17)-(275, 175), 14πLINE (51, 17)-(45, 20), 14πLINE (275, 17)-(270, 20), 14πLINE (275, 175)-(270, 180), 14πPAINT (273, 100), 6, 14πLINE (45, 181)-(270, 181), 12πLINE (276, 175)-(290, 189), 12πLINE (45, 181)-(31, 195), 12πLINE (270, 181)-(284, 195), 12πLINE (31, 195)-(284, 195), 12πLINE (290, 189)-(284, 195), 12πLINE (275, 176)-(270, 181), 12πPAINT (150, 185), 12πPAINT (282, 184), 4, 12ππFOR Y = 30 TO 170 STEP 20π  FOR X = 60 TO 260 STEP 28π    CIRCLE (X, Y), 8, 0π    PAINT (X, Y), 0, 0π    CIRCLE (X, Y), 6, 14, 4.6, .1π  NEXT XπNEXT YππEND SUBππSUB DropChip (X, ChipColor, Valid)ππ  Col = (X - 60) / 28 + 1        ' Calculates the Column (1-8)ππ  FOR C = 8 TO 2 STEP -1π    IF Grid(Col, C) = False THEN EXIT FORπ  NEXT Cππ  IF Grid(Col, C) = False THEN ' Empty Holder, place your chip hereπ    Grid(Col, C) = ChipColor     ' Make it filledπ    Row = ((C - 1) * 20) + 30    ' Calculate the Rowπ    CIRCLE (X, Row), 8, 8        ' Make Chip border color Dark Greyπ    PAINT (X, Row), ChipColor, 8 ' Fill chip colorπ    Valid = Trueπ    CheckForWin C, Col, ChipColorπ  END IFππEND SUBππSUB EraseChip (X)π π  PAINT (X, 7), 0ππEND SUBππSUB SwitchTurn (X, ChipColor, ChipColor2)ππ  EraseChip Xπ  SWAP ChipColor, ChipColor2    ' Swap the two variablesπ  X = 144                       ' Reset X Coordinatesπ  DrawChip X, ChipColorππEND SUBππSUB WhoWon (ChipColor)ππ  ' Check who winsπ  ' Do whatever you want for the closing screenππ  IF ChipColor = User THENπ    IF Player = 1 THEN PRINT "You Win!" ELSE PRINT "Player One Wins!"π  ELSEπ    IF Player = 1 THEN PRINT "Computer Wins!" ELSE PRINT "Player Two Wins!"π  END IFππ  ENDππEND SUBππGeorge Blank                   X-WING FIGHTER                 alt.lang.basic                 09-28-78 (00:00)       QB, QBasic, PDS        665  35172    XWING.BAS   10 KEY OFF: CLSπ20 SCREEN 0π30 WIDTH 40π40 PRINT "000000000000000000000000000000000000000"π50 PRINT "0ZDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDD?0"π60 PRINT "03                                   30"π70 PRINT "03            2060-A.BAS             30"π80 PRINT "03              XWING                30"π90 PRINT "03                                   30"π100 PRINT "03                                   30"π110 PRINT "03 BROUGHT TO YOU BY THE MEMBERS OF  30"π120 PRINT "03      \\\\\ \\\\\ \\\\\ \\\\\      30"π130 PRINT "03        [   [   [ [     [   [      30"π140 PRINT "03        [   [\\\[ [     [   [      30"π150 PRINT "03        [   [     [     [   [      30"π160 PRINT "03      \\[\\ [     [\\\\ [\\\[      30"π170 PRINT "03                                   30"π180 PRINT "03      International PC Owners      30"π190 PRINT "03                                   30"π200 PRINT "03P.O. Box 10426, Pittsburgh PA 1523430"π210 PRINT "03                                   30"π220 PRINT "0@DDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDY0"π230 PRINT "000000000000000000000000000000000000000"π240 PRINTπ250 PRINT "       PRESS ANY KEY TO CONTINUE"π260 A$ = INKEY$: IF A$ = "" THEN 260π270 WIDTH 80π280 CLSπ1000  REM * STAR PILOT GAME *π1010  REM * WRITTEN BY GEORGE BLANK, LEECHBURG, PA. *π1020  REM * FOR  PUBLIC DOMAIN UNLESS MOVIEMAKERS OBJECT *π1030  REM * VERSION 4.0    SEPTEMBER 25,1978 *π1040  REM * MODIFIED TO RUN ON THE IBM PC BY ERNEST *π1050  REM * SMITH AND RAYMOND ROGERS, HOUSTON, TEXAS *π1060  REM * DECEMBER 82 *π1070  KEY OFF: CLS : WIDTH 80: DEF SEG = 0: A = PEEK(&H410): POKE &H410, (A AND &HCF) OR &H20π1080  WIDTH 40: SCREEN 1: SCREEN 0: WIDTH 80: WIDTH 40: SCREEN 1: COLOR 0, 1π1090  GOTO 1200π1100  V = V - 1: IF V < -3 THEN V = -3π1110  RETURNπ1120  W = W - 1: IF W < -5 THEN W = -5π1130  RETURNπ1140  W = W + 1: IF W > 5 THEN W = 5π1150  RETURNπ1160  V = V + 1: IF V > 3 THEN V = 3π1170  RETURNπ1180  KEY(1) ON: KEY(2) ON: KEY(11) ON: KEY(12) ON: KEY(13) ON: KEY(14) ON: RETURNπ1190  KEY(1) STOP: KEY(2) STOP: KEY(11) STOP: KEY(12) STOP: KEY(13) STOP: KEY(14) STOP: RETURNπ1200    LOCATE 8, 1: PRINT "***************************************";π1210    PRINT "*                                     *";π1220    PRINT "*      X W I N G   F I G H T E R      *";π1230    PRINT "*                                     *";π1240    PRINT "***************************************";π1250  SOUND 525.25, 18.2: SOUND 783.99, 18.2 / 2: SOUND 698.46, 18.2 / 6: SOUND 659.26, 18.2 / 6: SOUND 587.33, 18.2 / 6: SOUND 1046.6, 18.2: SOUND 783.99, 18.2 / 2: SOUND 698.46, 18.2 / 6: SOUND 659.26, 18.2 / 6: SOUND 587.33, 18.2 / 6π1260  SOUND 1046.5, 18.2: SOUND 783.99, 18.2 / 2: SOUND 698.46, 18.2 / 6: SOUND 659.26, 18.2 / 6: SOUND 698.46, 18.2 / 6: SOUND 587.33, 18.2π1270 LOCATE 16, 1: PRINT "DO YOU WANT INSTRUCTIONS (Y OR N)?";π1280  K$ = INKEY$: IF K$ = "Y" OR K$ = "y" GOTO 6930π1290  IF K$ <> "N" AND K$ <> "n" GOTO 1270π1300 CLS : CLEAR : DEFINT A-Z: DEFSNG G, J, O, Sπ1310 RANDOMIZE (VAL(RIGHT$(TIME$, 2)))π1320  ON KEY(1) GOSUB 5350: ON KEY(2) GOSUB 5750: ON KEY(11) GOSUB 1100: ON KEY(12) GOSUB 1120: ON KEY(13) GOSUB 1140: ON KEY(14) GOSUB 1160π1330  LOCATE 8, 1: PRINT "IMPERIAL FIGHTER:  ": DRAW "C2;BM145,59;M+0,0;BM+10,1;M+0,-2;M+2,2;M+0,-2;BM+10,-1;M+0,4;BM+6,-4;M+0,4;M+0,-2;M-6,0"π1340  DIM IM(6): DIM IM1(6): DIM IM2(6): DIM IM3(6): GET (145, 59)-(145, 59), IM: GET (145, 59)-(145, 59), IM1: GET (155, 58)-(157, 60), IM2: GET (167, 57)-(173, 61), IM3π1350  DIM IM4(13): IM4(0) = 22: IM4(1) = 7: IM4(2) = 128: IM4(3) = -32760: IM4(4) = 2048: IM4(5) = 128: IM4(6) = -22008: IM4(7) = -22358: IM4(8) = 128: IM4(9) = -32760: IM4(10) = 2048: IM4(11) = 128: IM4(12) = 8π1360  DIM IM5(20): IM5(0) = 26: IM5(1) = 9: IM5(2) = 128: IM5(3) = -32768!: IM5(4) = 128: IM5(5) = -32768!: IM5(6) = 128: IM5(7) = -32768!: IM5(8) = 128: IM5(9) = -32768!: IM5(10) = -21846: IM5(11) = -32598: IM5(12) = 128π1370  IM5(13) = -32768!: IM5(14) = 128: IM5(15) = -32768!: IM5(16) = 128: IM5(17) = -32768!: IM5(18) = 128: IM5(19) = -32768!π1380  DIM IM6(44): IM6(0) = 34: IM6(1) = 17: IM6(2) = 2048: IM6(5) = 32: IM6(7) = -32768!: IM6(9) = 512: IM6(12) = -32760: IM6(14) = 8192: IM6(15) = 32: IM6(17) = 2176: IM6(20) = 2: IM6(23) = 128: IM6(25) = 8192: IM6(28) = 8π1390  IM6(29) = 128: IM6(30) = 512: IM6(31) = 2: IM6(33) = -30720: IM6(36) = 32: IM6(38) = -32768!: IM6(40) = 512: IM6(43) = 8π1400  DIM IM7(44)π1410  IM7(0) = 30: IM7(1) = 21: IM7(2) = -22006: IM7(3) = -22358: IM7(4) = 32: IM7(5) = 8192: IM7(6) = -21846: IM7(7) = -32598: IM7(8) = 2048: IM7(9) = 128π1420  IM7(10) = 2048: IM7(11) = 128: IM7(12) = 2048: IM7(13) = 128: IM7(14) = 2048: IM7(15) = 128: IM7(16) = 2048: IM7(17) = 128: IM7(18) = 2048: IM7(19) = 128π1430  IM7(20) = 2560: IM7(21) = 32: IM7(22) = 2048: IM7(23) = 128: IM7(24) = 8704: IM7(25) = 128: IM7(26) = 2048: IM7(27) = 128: IM7(28) = 2048: IM7(29) = 128π1440  IM7(30) = 2048: IM7(31) = 128: IM7(32) = 2048: IM7(33) = 128: IM7(34) = 2048: IM7(35) = 128: IM7(36) = 2048: IM7(37) = 128: IM7(38) = -22518: IM7(39) = -22358π1450  IM7(40) = 2592: IM7(41) = 8192: IM7(42) = -21846: IM7(43) = -32598π1460  DIM IM8(102)π1470  IM8(0) = 50: IM8(1) = 29: IM8(3) = 2048: IM8(7) = 10: IM8(10) = 2048: IM8(11) = 128: IM8(14) = 8200: IM8(17) = 2048: IM8(18) = 8: IM8(21) = 514π1480  IM8(25) = -32640: IM8(28) = 8192: IM8(29) = 32: IM8(32) = 2184: IM8(35) = 514: IM8(36) = 2: IM8(38) = 2048: IM8(39) = -32760: IM8(40) = 128: IM8(42) = 8352π1490  IM8(43) = -32736: IM8(45) = 8194: IM8(46) = 2176: IM8(47) = 128: IM8(48) = 512: IM8(49) = 34: IM8(50) = -32766: IM8(51) = 128: IM8(52) = 10250: IM8(54) = -24448π1500  IM8(55) = 8704: IM8(56) = 32: IM8(58) = 136: IM8(59) = -24446: IM8(61) = -32256: IM8(62) = 514: IM8(63) = 128: IM8(65) = -30592: IM8(66) = 8: IM8(68) = 8192π1510  IM8(69) = 8224: IM8(72) = 8200: IM8(73) = 128: IM8(75) = 512: IM8(76) = 34: IM8(79) = -22528: IM8(80) = 128: IM8(83) = 8224: IM8(86) = 2048: IM8(87) = 8π1520  IM8(90) = 2050: IM8(94) = 136: IM8(97) = 10240: IM8(101) = 8π1530  LOCATE 10, 1: PRINT "DARTH VADER     :  ": DRAW "C2;BM145,75;M+0,0;BM+10,1;M+0,-2;M+2,2;M+0,-2;BM+11,-1;M-1,1;M+0,2;M+1,1;BM+4,-4;M+1,1;M+0,2;M-1,1;BM+1,-2;M-6,0"π1540  DIM DV(6): DIM DV1(6): DIM DV2(6): DIM DV3(6): GET (145, 75)-(145, 75), DV: GET (145, 75)-(145, 75), DV1: GET (155, 74)-(157, 76), DV2: GET (167, 73)-(173, 77), DV3π1550  DIM DV4(13)π1560  DV4(0) = 22: DV4(1) = 7: DV4(2) = 8: DV4(3) = 8320: DV4(4) = 8192: DV4(5) = 128: DV4(6) = -22008: DV4(7) = -22358: DV4(8) = 128: DV4(9) = 8200π1570  DV4(10) = 8192: DV4(11) = 8: DV4(12) = 128π1580  DIM DV5(20)π1590  DV5(0) = 26: DV5(1) = 9: DV5(2) = 8: DV5(3) = 8: DV5(4) = 32: DV5(5) = 2: DV5(6) = 128: DV5(7) = -32768!: DV5(8) = 128: DV5(9) = -32768!π1600  DV5(10) = -21846: DV5(11) = -32598: DV5(12) = 128: DV5(13) = -32768!: DV5(14) = 128: DV5(15) = -32768!: DV5(16) = 32: DV5(17) = 2: DV5(18) = 8: DV5(19) = 8π1610  DIM DV6(32)π1620  DV6(0) = 30: DV6(1) = 15: DV6(2) = -22528: DV6(4) = 2: DV6(6) = 8: DV6(8) = 34: DV6(10) = -32640: DV6(12) = 8320: DV6(14) = 2176: DV6(16) = 512π1630  DV6(19) = 2176: DV6(21) = 2080: DV6(23) = 2056: DV6(25) = 8194: DV6(27) = -32768!: DV6(29) = 2: DV6(31) = 168π1640  DIM DV7(44)π1650  DV7(0) = 32: DV7(1) = 21: DV7(2) = 10752: DV7(3) = -24406: DV7(4) = -32768!: DV7(5) = -30720: DV7(6) = -22014: DV7(7) = 682: DV7(8) = 520: DV7(9) = -30688π1660  DV7(10) = 544: DV7(11) = 8224: DV7(12) = 512: DV7(13) = 32: DV7(14) = 512: DV7(15) = 32: DV7(16) = 512: DV7(17) = 32: DV7(18) = 512: DV7(19) = 32π1670  DV7(20) = 512: DV7(21) = 136: DV7(22) = 512: DV7(23) = 32: DV7(24) = 2048: DV7(25) = 160: DV7(26) = 512: DV7(27) = 32: DV7(28) = 512: DV7(29) = 32π1680  DV7(30) = 512: DV7(31) = 32: DV7(32) = 512: DV7(33) = 32: DV7(34) = 520: DV7(35) = 544: DV7(36) = 546: DV7(37) = 2080: DV7(38) = -21888: DV7(39) = -24534π1690  DV7(40) = 546: DV7(41) = -32640: DV7(42) = -22006: DV7(43) = 170π1700  DIM DV8(76)π1710  DV8(0) = 46: DV8(1) = 25: DV8(3) = 10752: DV8(4) = 128: DV8(6) = -32768!: DV8(7) = 32: DV8(9) = -22526: DV8(10) = 8: DV8(12) = 512: DV8(13) = 2π1720  DV8(16) = -32640: DV8(18) = 512: DV8(19) = 8224: DV8(21) = 2048: DV8(22) = 2056: DV8(24) = 8192: DV8(25) = 2082: DV8(27) = -32766: DV8(28) = -30592: DV8(30) = -32248π1730  DV8(31) = 10240: DV8(32) = 128: DV8(33) = -30712: DV8(34) = 2048: DV8(35) = 128: DV8(36) = -24536: DV8(37) = 2048: DV8(38) = 128: DV8(39) = -32630: DV8(40) = 2048π1740  DV8(41) = 672: DV8(42) = -32760: DV8(44) = 2184: DV8(45) = 10: DV8(47) = 8322: DV8(48) = 32: DV8(50) = -32640: DV8(51) = 128: DV8(53) = -32224: DV8(56) = -30712π1750  DV8(59) = -24062: DV8(62) = -32768!: DV8(63) = 168: DV8(65) = 8192: DV8(66) = 136: DV8(68) = 2048: DV8(69) = 136: DV8(71) = 512: DV8(72) = 136: DV8(75) = 168π1760  LOCATE 12, 1: PRINT "DEATH STAR      :  ": DRAW "C3;BM145,91;M+0,0;BM+11,-1;M-1,1;M+2,0;M-1,1;BM+12,-3;M+1,0;M+1,1;M-3,0;M+0,1;M+3,0;M-1,1;M-1,0"π1770  DRAW "C3;BM+12,-5;M+2,0;M+1,1;M-4,0;M-1,1;M+6,0;M+0,1;M-6,0;M+0,1;M+6,0;M-1,1;M-4,0;M+1,1;M+2,0"π1780  DIM DS(8): DIM DS1(8): DIM DS2(8): DIM DS3(8): DIM DS4(8): GET (145, 91)-(145, 91), DS: GET (145, 91)-(145, 91), DS1: GET (155, 90)-(157, 92), DS2: GET (167, 89)-(170, 92), DS3: GET (178, 87)-(184, 93), DS4π1790  DIM EXPL3(18): DIM EXPL4(18): DIM EXPL5(18): DIM EXPL6(18): DIM EXPL7(18): DIM EXPL8(18)π1800  DATA 22,11,0,0,0,8194,0,-32608,-22006,2560,-32598,-22006,128,168,8706,0,0,0,0π1810  FOR I = 0 TO 18: READ EXPL3(I): NEXT Iπ1820  DATA 22,11,-30720,2048,136,-30718,-24544,-32608,-22006,-21848,-22358,-22006,-23936,10274,-30206,2048,-32632,-30720,0π1830  FOR I = 0 TO 18: READ EXPL4(I): NEXT Iπ1840  DATA 22,11,-30712,512,136,8194,-32760,-24416,-21974,-21976,-22358,-21974,-32608,2216,-30206,512,138,-30712,128π1850  FOR I = 0 TO 18: READ EXPL5(I): NEXT Iπ1860  DATA 22,11,-30712,2048,136,8194,-24536,-32608,-22006,-21976,-22358,-22006,-24448,10408,8706,2048,-32632,-30712,128π1870  FOR I = 0 TO 18: READ EXPL6(I): NEXT Iπ1880 DATA 22,11,-30688,2048,2080,8194,-32736,-32608,-21974,-22008,-22358,-22006,-24448,10408,8706,2048,-32632,-30688,32π1890  FOR I = 0 TO 18: READ EXPL7(I): NEXT Iπ1900  DATA 22,11,-30688,2048,2184,-30718,-24544,-32608,-22006,-21848,-22358,-22006,-23936,10274,-30206,2048,-32632,-30688,32π1910  FOR I = 0 TO 18: READ EXPL8(I): NEXT Iπ1920  LOCATE 17, 1: PRINT "SELECT SKILL LEVEL FROM 0 TO 3"π1930  S$ = INKEY$: IF S$ <> "0" AND S$ <> "1" AND S$ <> "2" AND S$ <> "3" GOTO 1920π1940  SKILL = VAL(S$): CLSπ1950  DIM LASAR(381)π1960  LASAR(0) = 148: LASAR(1) = 40: LASAR(2) = 64: LASAR(11) = 5136: LASAR(20) = 16385: LASAR(21) = 16385: LASAR(29) = 5120: LASAR(31) = 20: LASAR(38) = 256: LASAR(39) = 64: LASAR(40) = 256: LASAR(41) = 64: LASAR(48) = 20π1970  LASAR(50) = 5120: LASAR(57) = 16385: LASAR(60) = 16385: LASAR(66) = 5120: LASAR(70) = 20: LASAR(75) = 256: LASAR(76) = 64: LASAR(79) = 256: LASAR(85) = 4: LASAR(89) = 20480: LASAR(94) = 20480: LASAR(99) = 5π1980  LASAR(103) = 1280: LASAR(109) = 80: LASAR(113) = 80: LASAR(118) = 1280: LASAR(122) = 5: LASAR(128) = 20480: LASAR(131) = 20480: LASAR(138) = 5: LASAR(140) = 1280: LASAR(148) = 80: LASAR(150) = 80π1990  LASAR(157) = 1024: LASAR(159) = 1: LASAR(167) = 16385: LASAR(168) = 5120: LASAR(177) = 276: LASAR(178) = 64: LASAR(186) = 256: LASAR(187) = 84: LASAR(196) = 21505: LASAR(205) = 5120: LASAR(206) = 16385π2000  LASAR(214) = 256: LASAR(215) = 64: LASAR(216) = 20: LASAR(224) = 4: LASAR(225) = 256: LASAR(233) = 20480: LASAR(235) = 20480: LASAR(242) = 1280: LASAR(245) = 5: LASAR(252) = 80: LASAR(255) = 80π2010  LASAR(261) = 5: LASAR(264) = 1280: LASAR(270) = 20480: LASAR(274) = 20480: LASAR(279) = 1280: LASAR(284) = 5: LASAR(289) = 80: LASAR(294) = 80: LASAR(298) = 1: LASAR(303) = 1024: LASAR(307) = 5120π2020  LASAR(313) = 16385: LASAR(316) = 256: LASAR(317) = 64: LASAR(323) = 20: LASAR(326) = 20: LASAR(332) = 256: LASAR(333) = 64: LASAR(335) = 16385: LASAR(342) = 5120: LASAR(344) = 5120: LASAR(352) = 16385π2030  LASAR(353) = 256: LASAR(354) = 64: LASAR(362) = 20: LASAR(363) = 20: LASAR(371) = 256: LASAR(372) = 16448: LASAR(381) = 4096π2040  REM * INITIALIZE VARIABLES *π2050  M = INT(RND * 61) + 10: N = INT(RND * 21) + 10: O = INT(RND * 32001) + 70000!π2060  E = INT(RND * 61) + 10: F = INT(RND * 21) + 10: G = 25000π2070  H = INT(RND * 61) + 10: I = INT(RND * 21) + 10: J = INT(RND * 32001) + 40000!π2080  Q = 5: Z = 3π2090  IMX = 38: IMY = 21: IMR1 = 1: IMR2 = 1π2100  DVX = 38: DVY = 21: DVR1 = 1: DVR2 = 1π2110  IF SKILL = 0 THEN A1 = 5: A2 = 0: BYPASS = 3π2120  IF SKILL = 1 THEN A1 = 3: A2 = 0: BYPASS = 2π2130  IF SKILL = 2 THEN A1 = 2: A2 = 45: BYPASS = 1π2140  IF SKILL = 3 THEN A1 = 2: A2 = 30π2150 K$ = "5"π2160   LINE (1, 1)-(76, 42), 3, Bπ2170  DRAW "C3;BM2,21;M+0,0;BM+6,0;M+0,0;BM+6,0;M+0,0;BM+6,0;M+0,0;BM+6,0;M+0,0;BM+6,0;M+0,0;BM+12,0;M+0,0;BM+6,0;M+0,0;BM+6,0;M+0,0;BM+6,0;M+0,0;BM+6,0;M+0,0;BM+6,0;M+0,0"π2180  DRAW "C3;BM38,3;M+0,0;BM+0,3;M+0,0;BM+0,3;M+0,0;BM+0,3;M+0,0;BM+0,3;M+0,0;BM+0,3;M+0,0;BM+0,6;M+0,0;BM+0,3;M+0,0;BM+0,3;M+0,0;BM+0,3;M+0,0;BM+0,3;M+0,0;BM+0,3;M+0,0"π2190  LOCATE 8, 1: PRINT "REPUBLIC      X-WING     STAR FIGHTER"π2200  LOCATE 10, 5: PRINT "TORPEDOES"π2210 LOCATE 12, 1: PRINT "HOR.   VERT. DIRECTION"π2220  LOCATE 15, 1: PRINT "SPEED MACH"π2230  LOCATE 17, 1: PRINT "RADAR TARGETS"π2240  LOCATE 18, 8: PRINT "KM TO IMPERIAL FIGHTER"π2250  LOCATE 19, 8: PRINT "KM TO DARTH VADER"π2260  LOCATE 20, 8: PRINT "KM TO DEATH STAR"π2270  LOCATE 22, 1: PRINT "TIME REMAINING"π2280  PLAY "T250"π2290   SEC1 = VAL(RIGHT$(TIME$, 2))π2300  GOSUB 1180π2310  REM * MASTER CONTROL ROUTINE *π2320  GOSUB 1190π2330  PUT (38, 21), DS1π2340  LOCATE 10, 1: PRINT Zπ2350 LOCATE 13, 1: PRINT W; "     "; -Vπ2360  LOCATE 15, 12: PRINT Q * 10π2370  GS = G - S: IF GS < 0 THEN GS = 0π2380  LOCATE 18, 1: PRINT GSπ2390  JS = J - S: IF JS < 0 THEN JS = 0π2400  LOCATE 19, 1: PRINT JSπ2410  OS = O - S: IF OS < 0 THEN OS = 0π2420  LOCATE 20, 1: PRINT OSπ2430  LOCATE 22, 16: PRINT A1; ":"; A2NEWπ2440  SOUND 37 * Q, 1π2450  PUT (38, 21), DS1π2460  GOSUB 1180π2470  REM * DISPLAY DEATH STAR *π2480  IF O - S = 30000 OR O - S > 30000 GOTO 2840π2490  IF O - S < 20000 AND DSTAR2 = 0 THEN DSTAR2 = 1: DSFLAG = 1: DS(0) = DS2(0): DS(1) = DS2(1): DS(2) = DS2(2): DS(3) = DS2(3)π2500  IF O - S < 10000 AND DSTAR3 = 0 THEN DSTAR3 = 1: DSFLAG = 2: DS(0) = DS3(0): DS(1) = DS3(1): DS(2) = DS3(2): DS(3) = DS3(3)π2510  IF O - S < 5000 AND DSTAR4 = 0 THEN DSTAR4 = 1: DSFLAG = 3: DS(0) = DS4(0): DS(1) = DS4(1): DS(2) = DS4(2): DS(3) = DS4(3): DS(4) = DS4(4): DS(5) = DS4(5): DS(6) = DS4(6): DS(7) = DS4(7): DS(8) = DS4(8)π2520  IF FLAG1 <> BYPASS THEN FLAG1 = FLAG1 + 1: GOTO 2550π2530  FLAG1 = 0π2540  M = M + INT(RND * 5) - 2: N = N + INT(RND * 5) - 2π2550  M = M - W: N = N - Vπ2560  IF M < 2 THEN M = 2 + INT(RND * 3)π2570  IF M > 69 THEN M = 69 - INT(RND * 3)π2580  IF N < 2 THEN N = 2 + INT(RND * 3)π2590  IF N > 35 THEN N = 35 - INT(RND * 3)π2600  GOSUB 1190π2610  PUT (M, N), DSπ2620  IF DSNEW = 0 THEN DSNEW = 1: GOTO 2680π2630  IF DSFLAG = 0 GOTO 2670π2640  IF DSFLAG = 1 THEN DSFLAG = 0: PUT (MP, NP), DS1: GOTO 2680π2650  IF DSFLAG = 2 THEN DSFLAG = 0: PUT (MP, NP), DS2: GOTO 2680π2660  IF DSFLAG = 3 THEN DSFLAG = 0: PUT (MP, NP), DS3: GOTO 2680π2670  PUT (MP, NP), DSπ2680  GOSUB 1180π2690  MP = M: NP = Nπ2700  IF O - S > 10000 OR FLAG = 1 GOTO 2840π2710  GOSUB 1190π2720  FOR K = 1 TO 2π2730   LOCATE 24, 1: PRINT "*** DEATH STAR WITHIN TORPEDO RANGE ***";π2740  PLAY "L2 N0"π2750   LOCATE 24, 1: PRINT "                                       ";π2760  PLAY "L16 N0"π2770  NEXT Kπ2780   LOCATE 24, 1: PRINT "*** DEATH STAR WITHIN TORPEDO RANGE ***";π2790   PLAY "L1 N0": PLAY "L1 N0"π2800   LOCATE 24, 1: PRINT "                                       ";π2810  GOSUB 1180π2820  FLAG = 1π2830  REM * DISPLAY IMPERIAL FIGHTER *π2840  GOSUB 1190π2850  IF G - S > 26000 THEN GOSUB 1180: GOTO 3910π2860  IF G - S < 20000 AND IMPFIGH2 = 0 THEN IMPFIGH2 = 1: IMFLAG = 1: IM(0) = IM2(0): IM(1) = IM2(1): IM(2) = IM2(2): IM(3) = IM2(3): IMX = 37: IMY = 20: IMR1 = 2: IMR2 = 2π2870  IF G - S < 10000 AND IMPFIGH3 = 0 THEN IMPFIGH3 = 1: IMFLAG = 2: IM(0) = IM3(0): IM(1) = IM3(1): IM(2) = IM3(2): IM(3) = IM3(3): IM(4) = IM3(4): IM(5) = IM3(5): IM(6) = IM3(6): IMX = 35: IMY = 19: IMR1 = 4: IMR2 = 3π2880  IF FLAG2 <> BYPASS THEN FLAG2 = FLAG2 + 1: GOTO 2910π2890  FLAG2 = 0π2900 E = E + INT(RND * 5) - 2: F = F + INT(RND * 5) - 2π2910 E = E - W: F = F - Vπ2920 IF E < 2 THEN E = 2 + INT(RND * 3)π2930 IF E > 69 THEN E = 69 - INT(RND * 3)π2940 IF F < 2 THEN F = 2 + INT(RND * 3)π2950 IF F > 37 THEN F = 37 - INT(RND * 3)π2960  PUT (E, F), IMπ2970  IF IMNEW = 0 THEN IMNEW = 1: GOTO 3020π2980  IF IMFLAG = 0 GOTO 3010π2990  IF IMFLAG = 1 THEN IMFLAG = 0: PUT (EP, FP), IM1: GOTO 3020π3000  IF IMFLAG = 2 THEN IMFLAG = 0: PUT (EP, FP), IM2: GOTO 3020π3010  PUT (EP, FP), IMπ3020  GOSUB 1180π3030  EP = E: FP = Fπ3040  IF G - S > 5000 OR FLAG3 = 1 GOTO 3170π3050  GOSUB 1190π3060  FOR K = 1 TO 2π3070  LOCATE 24, 1: PRINT "**** IMPERIAL FIGHTER ATTACKS ****";π3080  PLAY "L2 N0"π3090  LOCATE 24, 1: PRINT "                                  ";π3100  PLAY "L16 N0"π3110  NEXT Kπ3120  LOCATE 24, 1: PRINT "**** IMPERIAL FIGHTER ATTACKS ****";π3130  PLAY "L1 N0": PLAY "L1 N0"π3140  LOCATE 24, 1: PRINT "                                  ";π3150  GOSUB 1180π3160  FLAG3 = 1π3170 IF G > S THEN GOTO 3910π3180  REM * IMPERIAL FIGHTER ATTACKS *π3190  FLAG3 = 0: IMNEW = 0: IMNEW1 = 0: IMPFIGH2 = 0: IMPFIGH3 = 0: PUT (E, F), IMπ3200  GOSUB 1190π3210  DELTAX = 29 - E: DELTAY = 19 - Fπ3220  IF DELTAX > 0 THEN E = E + 1π3230  IF DELTAX < 0 THEN E = E - 1π3240  IF DELTAY > 0 THEN F = F + 1π3250  IF DELTAY < 0 THEN F = F - 1π3260  IF DELTAX = 0 AND DELTAY = 0 GOTO 3320π3270  PUT (E, F), IM: IF IMNEW1 = 0 THEN IMNEW1 = 1: GOTO 3290π3280  PUT (EP, FP), IMπ3290  EP = E: FP = Fπ3300  PLAY "P32"π3310  GOTO 3210π3320  PUT (EP - 4, FP - 1), IM4π3330  PUT (EP, FP), IMπ3340  PLAY "P4"π3350  PUT (EP - 9, FP - 2), IM5π3360  PUT (EP - 4, FP - 1), IM4π3370  PLAY "P4"π3380  PUT (EP - 12, FP - 6), IM6π3390  PUT (EP - 9, FP - 2), IM5π3400  PLAY "P4"π3410  PUT (EP - 9, FP - 7), IM7π3420  PUT (EP - 12, FP - 6), IM6π3430  PLAY "P4"π3440  PUT (EP - 20, FP - 14), IM8π3450  PUT (EP - 9, FP - 7), IM7π3460  PLAY "P4"π3470  PUT (EP - 20, FP - 14), IM8π3480  FOR J2 = 10000 TO 100 STEP -500π3490  SOUND J2, .001 * 18.2π3500  NEXT J2π3510  FOR A = 1 TO 50: NEXT Aπ3520  FOR J2 = 10000 TO 100 STEP -500π3530  SOUND J2, .001 * 18.2π3540  NEXT J2π3550  G = G + 25000π3560  E = INT(RND * 61) + 10: F = INT(RND * 21) + 10π3570  K = INT(RND * 10)π3580  IF K > SKILL THEN 3790π3590  KEY(1) OFF: KEY(2) OFF: KEY(11) OFF: KEY(12) OFF: KEY(13) OFF: KEY(14) OFFπ3600  CLSπ3610  PRINT "BLAM!"π3620  FOR J2 = 1000 TO 37 STEP -10π3630  SOUND J2, .01 * 18.2π3640  NEXT J2π3650  PRINTπ3660  PLAY "L1 N0": PLAY "L1 N0": PLAY "L1 N0"π3670  PRINT "YOU HAVE JUST BEEN SHOT DOWN BY AN";π3680  PRINT "IMPERIAL SKY FIGHTER!"π3690  PRINTπ3700  PLAY "L1 N0": PLAY "L1 N0": PLAY "L1 N0"π3710  PRINT "YOU ARE A HERO!"π3720  PRINTπ3730  PRINT "UNFORTUNATELY, YOU ARE A DEAD HERO AND";π3740  PRINT "DEAD HEROES DON'T WIN WARS. DARTH VADER";π3750  PRINT "WINS!"π3760  PRINTπ3770  PRINT "*********   YOU   LOSE!!   *********"π3780   GOTO 5310π3790  FOR K = 1 TO 2π3800  LOCATE 24, 1: PRINT "**** IMPERIAL FIGHTER MISSED ****";π3810  PLAY "L2 N0"π3820  LOCATE 24, 1: PRINT "                                 ";π3830  PLAY "L16 N0"π3840  NEXT Kπ3850  LOCATE 24, 1: PRINT "**** IMPERIAL FIGHTER MISSED ****";π3860  PLAY "L1 N0": PLAY "L1 N0"π3870  LOCATE 24, 1: PRINT "                                 ";π3880  IM(0) = IM1(0): IM(1) = IM1(1): IM(2) = IM1(2): IM(3) = IM1(3): IM(4) = IM1(4): IM(5) = IM1(5): IM(6) = IM1(6)π3890  GOSUB 1180π3900  REM * DISPLAY DARTH VADER *π3910  GOSUB 1190π3920  IF J - S > 26000 THEN GOSUB 1180: GOTO 5140π3930  IF J - S < 20000 AND DVADER2 = 0 THEN DVADER2 = 1: DVFLAG = 1: DV(0) = DV2(0): DV(1) = DV2(1): DV(2) = DV2(2): DV(3) = DV2(3): DVX = 37: DVY = 20: DVR1 = 2: DVR2 = 2π3940  IF J - S < 10000 AND DVADER3 = 0 THEN DVADER3 = 1: DVFLAG = 2: DV(0) = DV3(0): DV(1) = DV3(1): DV(2) = DV3(2): DV(3) = DV3(3): DV(4) = DV3(4): DV(5) = DV3(5): DV(6) = DV3(6): DVX = 35: DVY = 19: DVR1 = 4: DVR2 = 3π3950  IF FLAG2 <> BYPASS THEN FLAG2 = FLAG2 + 1: GOTO 3980π3960  FLAG2 = 0π3970 H = H + INT(RND * 5) - 2: I = I + INT(RND * 5) - 2π3980 H = H - W: I = I - Vπ3990 IF H < 2 THEN H = 2 + INT(RND * 3)π4000 IF H > 69 THEN H = 69 - INT(RND * 3)π4010 IF I < 2 THEN I = 2 + INT(RND * 3)π4020 IF I > 37 THEN I = 37 - INT(RND * 3)π4030  PUT (H, I), DVπ4040  IF DVNEW = 0 THEN DVNEW = 1: GOTO 4090π4050  IF DVFLAG = 0 GOTO 4080π4060  IF DVFLAG = 1 THEN DVFLAG = 0: PUT (HP, IP), DV1: GOTO 4090π4070  IF DVFLAG = 2 THEN DVFLAG = 0: PUT (HP, IP), DV2: GOTO 4090π4080  PUT (HP, IP), DVπ4090  GOSUB 1180π4100  HP = H: IP = Iπ4110  IF J - S > 5000 OR FLAG4 = 1 GOTO 4350π4120  GOSUB 1190π4130  IF DVGONE = 0 GOTO 4240π4140  FOR K = 1 TO 2π4150  LOCATE 24, 1: PRINT "**** IMPERIAL FIGHTER ATTACKS ****";π4160  PLAY "L2 N0"π4170  LOCATE 24, 1: PRINT "                                  ";π4180  PLAY "L16 N0"π4190  NEXT Kπ4200  LOCATE 24, 1: PRINT "**** IMPERIAL FIGHTER ATTACKS ****";π4210  PLAY "L1 N0": PLAY "L1 N0"π4220  LOCATE 24, 1: PRINT "                                  ";π4230  GOTO 4330π4240  FOR K = 1 TO 2π4250  LOCATE 24, 1: PRINT "**** DARTH VADER ATTACKS ****";π4260  PLAY "L2 N0"π4270  LOCATE 24, 1: PRINT "                             ";π4280  PLAY "L16 N0"π4290  NEXT Kπ4300  LOCATE 24, 1: PRINT "**** DARTH VADER ATTACKS ****";π4310  PLAY "L1 N0": PLAY "L1 N0"π4320  LOCATE 24, 1: PRINT "                             ";π4330  FLAG4 = 1π4340  GOSUB 1180π4350  IF J > S THEN GOTO 5140π4360  REM * DARTH VADER ATTACKS *π4370  FLAG4 = 0: DVNEW = 0: DVNEW1 = 0: DVADER2 = 0: DVADER3 = 0: PUT (H, I), DVπ4380  GOSUB 1190π4390  DELTAX = 41 - H: DELTAY = 19 - Iπ4400  IF DELTAX > 0 THEN H = H + 1π4410  IF DELTAX < 0 THEN H = H - 1π4420  IF DELTAY > 0 THEN I = I + 1π4430  IF DELTAY < 0 THEN I = I - 1π4440  IF DELTAX = 0 AND DELTAY = 0 GOTO 4500π4450  PUT (H, I), DV: IF DVNEW1 = 0 THEN DVNEW1 = 1: GOTO 4470π4460  PUT (HP, IP), DVπ4470  HP = H: IP = Iπ4480  PLAY "P32"π4490  GOTO 4390π4500  IF DVGONE = 0 THEN PUT (HP, IP - 1), DV4 ELSE PUT (HP, IP - 1), IM4π4510  PUT (HP, IP), DVπ4520  PLAY "P4"π4530  IF DVGONE = 0 THEN PUT (HP + 3, IP - 2), DV5 ELSE PUT (HP + 3, IP - 2), IM5π4540  IF DVGONE = 0 THEN PUT (HP, IP - 1), DV4 ELSE PUT (HP, IP - 1), IM4π4550  PLAY "P4"π4560  IF DVGONE = 0 THEN PUT (HP + 2, IP - 6), DV6 ELSE PUT (HP + 2, IP - 6), IM6π4570  IF DVGONE = 0 THEN PUT (HP + 3, IP - 2), DV5 ELSE PUT (HP + 3, IP - 2), IM5π4580  PLAY "P4"π4590  IF DVGONE = 0 THEN PUT (HP + 1, IP - 6), DV7 ELSE PUT (HP + 1, IP - 6), IM7π4600  IF DVGONE = 0 THEN PUT (HP + 2, IP - 6), DV6 ELSE PUT (HP + 2, IP - 6), IM6π4610  PLAY "P4"π4620  IF DVGONE = 0 THEN PUT (HP + 2, IP - 6), DV8 ELSE PUT (HP + 2, IP - 6), IM8π4630  IF DVGONE = 0 THEN PUT (HP + 1, IP - 6), DV7 ELSE PUT (HP + 1, IP - 6), IM7π4640  PLAY "P4"π4650  IF DVGONE = 0 THEN PUT (HP + 2, IP - 6), DV8 ELSE PUT (HP + 2, IP - 6), IM8π4660  FOR J2 = 10000 TO 100 STEP -500π4670  SOUND J2, .001 * 18.2π4680  NEXT J2π4690  FOR A = 1 TO 50: NEXT Aπ4700  FOR J2 = 10000 TO 100 STEP -500π4710  SOUND J2, .001 * 18.2π4720  NEXT J2π4730  J = J + 25000π4740 H = INT(RND * 61) + 10: I = INT(RND * 21) + 10π4750  K = INT(RND * 10)π4760  IF K > SKILL + 1 THEN 4910π4770  KEY(1) OFF: KEY(2) OFF: KEY(11) OFF: KEY(12) OFF: KEY(13) OFF: KEY(14) OFFπ4780  CLS : PRINT "****  B O O M !  ****"π4790  FOR J2 = 1000 TO 37 STEP -10π4800  SOUND J2, .01 * 18.2π4810  NEXT J2π4820  PRINTπ4830  PLAY "L1 N0": PLAY "L1 N0": PLAY "L1 N0"π4840  IF DVGONE = 1 THEN PRINT "TOO BAD.  YOU HAVE BEEN SHOT DOWN.": GOTO 4880π4850  PRINT "YOU HAVE JUST BEEN PERSONALLY SHOT DOWN";π4860  PRINT "BY DARTH VADER.  THE FORCE WAS NOT WITH";π4870  PRINT "YOU."π4880  PRINTπ4890  PRINT "*********   YOU   LOSE!!   *********"π4900   GOTO 5310π4910  IF DVGONE = 0 GOTO 5030π4920  FOR K = 1 TO 2π4930  LOCATE 24, 1: PRINT "**** IMPERIAL FIGHTER MISSED ****";π4940  PLAY "L2 N0"π4950  LOCATE 24, 1: PRINT "                                 ";π4960  PLAY "L16 N0"π4970  NEXT Kπ4980  LOCATE 24, 1: PRINT "**** IMPERIAL FIGHTER MISSED ****";π4990  PLAY "L1 N0": PLAY "L1 N0"π5000  LOCATE 24, 1: PRINT "                                 ";π5010  DV(0) = DV1(0): DV(1) = DV1(1): DV(2) = DV1(2): DV(3) = DV1(3)π5020  GOTO 5140π5030  FOR K = 1 TO 2π5040  LOCATE 24, 1: PRINT "**** DARTH VADER MISSED ****";π5050  PLAY "L2 N0"π5060  LOCATE 24, 1: PRINT "                            ";π5070  PLAY "L16 N0"π5080  NEXT Kπ5090  LOCATE 24, 1: PRINT "**** DARTH VADER MISSED ****";π5100  PLAY "L1 N0": PLAY "L1 N0"π5110  LOCATE 24, 1: PRINT "                            ";π5120  DV(0) = DV1(0): DV(1) = DV1(1): DV(2) = DV1(2): DV(3) = DV1(3): DV(4) = DV1(4): DV(5) = DV1(5): DV(6) = DV1(6)π5130  REM * X - WING FIGHTER ROUTINE *π5140  GOSUB 1180π5150 Z$ = INKEY$π5160 IF VAL(Z$) > 0 AND VAL(Z$) < 10 THEN Q = VAL(Z$)π5170  S = S + Q * 100π5180  IF S > O GOTO 6410π5190  REM * TIME ROUTINE *π5200   SEC2 = VAL(RIGHT$(TIME$, 2))π5210   SECNEW = SEC2π5220   IF SECNEW = SECOLD GOTO 5280π5230   IF SECNEW < SECOLD THEN N8 = N8 + 1π5240   SECOLD = SEC2π5250   A2NEW = A2 - (SEC2 + (60 * N8) - SEC1)π5260   IF A2NEW < 0 THEN A2NEW = A2NEW + 60: A1 = A1 - 1: A2 = A2 + 60π5270   IF A1 < 0 GOTO 6760π5280   GOTO 2320π5290  REM * DISPLAY SKY FIGHTER *π5300  IF J - S < 10000 THEN A = 3π5310  REM * NEW GAME *π5320   PRINTπ5330 PRINT "HIT ENTER TO PLAY AGAIN, ESC TO GIVE UP"π5340 B$ = INKEY$: IF B$ = CHR$(13) THEN GOTO 1300 ELSE IF B$ = CHR$(27) THEN CLS : WIDTH 80: SCREEN 0: KEY ON: END ELSE GOTO 5340π5350  REM * FIRE CANNON *π5360  KEY(2) STOP: KEY(11) STOP: KEY(12) STOP: KEY(13) STOP: KEY(14) STOPπ5370  PUT (2, 2), LASARπ5380  FOR J2 = 5000 TO 100 STEP -250π5390    SOUND J2, .01 * 18.2π5400  NEXT J2π5410  PUT (2, 2), LASARπ5420  IF G - S < 26000 AND ABS(IMX - E) < IMR1 AND ABS(IMY - F) < IMR2 GOTO 5450π5430  IF J - S < 26000 AND ABS(DVX - H) < DVR1 AND ABS(DVY - I) < DVR2 GOTO 5580π5440  GOTO 5730π5450  FOR I9 = 1 TO 2: PUT (E - 2, F - 3), EXPL3: PLAY "P64": PUT (E - 2, F - 3), EXPL3: NEXT I9π5460  FOR I9 = 1 TO 2: PUT (E - 2, F - 3), EXPL4: PLAY "P64": PUT (E - 2, F - 3), EXPL4: NEXT I9π5470  PUT (E, F), IMπ5480  IF IMR2 = 1 GOTO 5540π5490  FOR I9 = 1 TO 2: PUT (E - 2, F - 3), EXPL5: PLAY "P64": PUT (E - 2, F - 3), EXPL5: NEXT I9π5500  FOR I9 = 1 TO 2: PUT (E - 2, F - 3), EXPL6: PLAY "P64": PUT (E - 2, F - 3), EXPL6: NEXT I9π5510  IF IMR2 = 2 GOTO 5540π5520  FOR I9 = 1 TO 2: PUT (E - 2, F - 3), EXPL7: PLAY "P64": PUT (E - 2, F - 3), EXPL7: NEXT I9π5530  FOR I9 = 1 TO 2: PUT (E - 2, F - 3), EXPL8: PLAY "P64": PUT (E - 2, F - 3), EXPL8: NEXT I9π5540  G = G + 25000: E = INT(RND * 61) + 10: F = INT(RND * 21) + 10: FLAG3 = 0: IMNEW = 0: IMPFIGH2 = 0: IMPFIGH3 = 0π5550  IMX = 38: IMY = 21: IMR1 = 1: IMR2 = 1π5560  IM(0) = IM1(0): IM(1) = IM1(1): IM(2) = IM1(2): IM(3) = IM1(3): IM(4) = IM1(4): IM(5) = IM1(5): IM(6) = IM1(6)π5570  GOTO 5730π5580  FOR I9 = 1 TO 2: PUT (H - 2, I - 3), EXPL3: PLAY "P64": PUT (H - 2, I - 3), EXPL3: NEXT I9π5590  FOR I9 = 1 TO 2: PUT (H - 2, I - 3), EXPL4: PLAY "P64": PUT (H - 2, I - 3), EXPL4: NEXT I9π5600  PUT (H, I), DVπ5610  IF DVR2 = 1 GOTO 5670π5620  FOR I9 = 1 TO 2: PUT (H - 2, I - 3), EXPL5: PLAY "P64": PUT (H - 2, I - 3), EXPL5: NEXT I9π5630  FOR I9 = 1 TO 2: PUT (H - 2, I - 3), EXPL6: PLAY "P64": PUT (H - 2, I - 3), EXPL6: NEXT I9π5640  IF DVR2 = 2 GOTO 5670π5650  FOR I9 = 1 TO 2: PUT (H - 2, I - 3), EXPL7: PLAY "P64": PUT (H - 2, I - 3), EXPL7: NEXT I9π5660  FOR I9 = 1 TO 2: PUT (H - 2, I - 3), EXPL8: PLAY "P64": PUT (H - 2, I - 3), EXPL8: NEXT I9π5670  J = J + 25000: H = INT(RND * 61) + 10: I = INT(RND * 21) + 10: FLAG4 = 0: LOCATE 19, 8: PRINT "KM TO IMPERIAL FIGHTER";π5680  DVNEW = 0: DVADER2 = 0: DVADER3 = 0π5690  DVX = 38: DVY = 21: DVR1 = 1: DVR2 = 1π5700  IF DVGONE = 0 THEN DV3(0) = IM3(0): DV3(1) = IM3(1): DV3(2) = IM3(2): DV3(3) = IM3(3): DV3(4) = IM3(4): DV3(5) = IM3(5): DV3(6) = IM3(6)π5710  DV(0) = DV1(0): DV(1) = DV1(1): DV(2) = DV1(2): DV(3) = DV1(3): DV(4) = DV1(4): DV(5) = DV1(5): DV(6) = DV1(6)π5720  DVGONE = 1π5730  KEY(2) ON: KEY(11) ON: KEY(12) ON: KEY(13) ON: KEY(14) ONπ5740  RETURNπ5750  REM * FIRE  TORPEDO *π5760  KEY(1) STOP: KEY(11) STOP: KEY(12) STOP: KEY(13) STOP: KEY(14) STOPπ5770  IF Z = 0 THEN 3600π5780  FOR J2 = 1500 TO 100 STEP -20π5790    SOUND J2, .01 * 18.2π5800    SOUND 3600 - J2, .01 * 18.2π5810  NEXT J2π5820  Z = Z - 1π5830  IF O - S > 10000 THEN 5990π5840  IF POINT(38, 21) <> 3 THEN 5880π5850  IF SKILL = 0 GOTO 6100π5860  K = INT(RND * 10)π5870  IF K > SKILL + 1 THEN 6100π5880   FOR K = 1 TO 2π5890  LOCATE 24, 1: PRINT "**** TORPEDO  MISSED  ****";π5900  PLAY "L2 N0"π5910  LOCATE 24, 1: PRINT "                          ";π5920  PLAY "L16 N0"π5930   NEXT Kπ5940  LOCATE 24, 1: PRINT "**** TORPEDO  MISSED  ****";π5950  PLAY "L1 N0": PLAY "L1 N0"π5960  LOCATE 24, 1: PRINT "                          ";π5970  IF Z <= 0 THEN 4780π5980  GOTO 6080π5990 FOR K = 1 TO 2π6000  LOCATE 24, 1: PRINT "**** OUT  OF  RANGE  ****";π6010  PLAY "L2 N0"π6020  LOCATE 24, 1: PRINT "                         ";π6030  PLAY "L16 N0"π6040 NEXT Kπ6050  LOCATE 24, 1: PRINT "**** OUT  OF  RANGE  ****";π6060  PLAY "L1 N0": PLAY "L1 N0"π6070  LOCATE 24, 1: PRINT "                         ";π6080  KEY(1) ON: KEY(11) ON: KEY(12) ON: KEY(13) ON: KEY(14) ONπ6090   RETURNπ6100  REM * GAME WON *π6110  KEY(1) OFF: KEY(2) OFF: KEY(11) OFF: KEY(12) OFF: KEY(13) OFF: KEY(14) OFFπ6120  FOR SCALE = 1 TO 24π6130  DRAW "C3;S=SCALE;BM38,21;NM+6,0;NM-6,0;NM+0,-3;NM+0,3;NM-6,3;NM+6,-3;NM-6,-3;NM+6,3;NM+3,-3;NM-3,3;NM+3,3;NM-3,-3;NM+6,2;NM-6,-2;NM-6,1;NM+6,-1;NM+1,3;NM-1,-3"π6140  NEXT SCALEπ6150  CLSπ6160  FOR K = 1 TO 5π6170  SOUND 37, .1 * 18.2π6180  SCREEN 0: WIDTH 40π6190  FOR A = 1 TO 10: NEXT Aπ6200  SCREEN 1: WIDTH 80π6210  NEXT Kπ6220  WIDTH 40π6230  CLS : PRINT : PRINT : PRINTπ6240  PRINT "* * * * * * * * * * * * * * * * * * * *";π6250  PRINT "*                                     *";π6260  PRINT "*                                     *";π6270  PRINT "*    THE  FORCE  IS  WITH  YOU  !!    *";π6280  PRINT "*                                     *";π6290  PRINT "* YOU HAVE DESTROYED THE DEATH STAR ! *";π6300  PRINT "*                                     *";π6310  PRINT "*    YOU HAVE SAVED THE REPUBLIC !    *";π6320  PRINT "*                                     *";π6330  PRINT "* PRINCESS LEAH WILL LOVE YOU ALWAYS! *";π6340  PRINT "*                                     *";π6350  PRINT "* * * * * * * * * * * * * * * * * * * *"π6360  SOUND 525.25, 18.2: SOUND 783.99, 18.2 / 2: SOUND 698.46, 18.2 / 6: SOUND 659.26, 18.2 / 6: SOUND 587.33, 18.2 / 6: SOUND 1046.6, 18.2: SOUND 783.99, 18.2 / 2: SOUND 698.46, 18.2 / 6: SOUND 659.26, 18.2 / 6: SOUND 587.33, 18.2 / 6π6370  SOUND 1046.5, 18.2: SOUND 783.99, 18.2 / 2: SOUND 698.46, 18.2 / 6: SOUND 659.26, 18.2 / 6: SOUND 698.46, 18.2 / 6: SOUND 587.33, 18.2π6380  PRINTπ6390  GOTO 5310π6400  REM * COLLISION WITH DEATH STAR *π6410 KEY(1) OFF: KEY(2) OFF: KEY(11) OFF: KEY(12) OFF: KEY(13) OFF: KEY(14) OFFπ6420  DELTAX = 35 - M: DELTAY = 18 - Nπ6430  IF DELTAX > 0 THEN M = M + 1π6440  IF DELTAX < 0 THEN M = M - 1π6450  IF DELTAY > 0 THEN N = N + 1π6460  IF DELTAY < 0 THEN N = N - 1π6470  IF DELTAX = 0 AND DELTAY = 0 GOTO 6530π6480  PUT (M, N), DSπ6490  PUT (MP, NP), DSπ6500  MP = M: NP = Nπ6510  PLAY "P32"π6520  GOTO 6420π6530  FOR RAD = 4 TO 20π6540  CIRCLE (38, 21), RAD, 3π6550  PLAY "P32"π6560  NEXT RADπ6570  CLS : PRINT "CRASH"π6580  FOR J2 = 1000 TO 37 STEP -10π6590  SOUND J2, .01 * 18.2π6600  NEXT J2π6610  PLAY "L1 N0": PLAY "L1 N0": PLAY "L1 N0"π6620  PRINTπ6630  PRINT "DAOFF"π6760π6770  CLS : PRINT "TOO LATE!"π6780  FOR J2 = 1000 TO 37 STEP -10π6790  SOUND J2, .01 * 18.2π6800  NEXT J2π6810  PLAY "L1 N0": PLAY "L1 N0": PLAY "L1 N0"π6820  PRINTπ6830  PRINT "DARTH VADER IS LAUGHING AT YOU."π6840  PLAY "L1 N0": PLAY "L1 N0": PLAY "L1 N0"π6850  PRINTπ6860  PRINT "THE DEATH STAR HAS JUST DESTROYED";π6870  PRINT "PRINCESS LEAH AND THE ENTIRE REBEL";π6880  PRINT "STRONGHOLD";π6890  PRINTπ6900  PRINT "*********   YOU  LOSE!!   *********"π6910  PRINTπ6920   GOTO 5310π6930  CLSπ6940  PRINT "       STAR  PILOT  INSTRUCTIONS"π6950  PRINTπ6960  PRINT "    THE DEATH  STAR SPACE STATION, UNDER";π6970  PRINT "THE COMMAND OF DARTH  VADER, IS THE MOST";π6980  PRINT "POWERFUL  WEAPON  THE UNIVERSE  HAS EVER";π6990  PRINT "KNOWN.   A FRONTAL  ATTACK BY  ANY OTHER";π7000  PRINT "CRAFT WOULD BE ABSOLUTE SUICIDE. HOWEVER";π7010  PRINT "INTELLIGENCE DELIVERED  TO  OUR REPUBLIC";π7020  PRINT "HEADQUARTERS  BY  THE  ANDROIDS R2D2 AND";π7030  PRINT "C3PO GIVES A FAINT  HOPE OF A SUCCESSFUL";π7040  PRINT "ATTACK  BY A SMALL ONE OR TWO  PASSENGER";π7050  PRINT "X-WING FIGHTER."π7060  PRINTπ7070  PRINT "    THERE IS A SMALL, UNSHIELDED EXHAUST";π7080  PRINT "PORT  ON  THE  SURFACE OF THE DEATH STAR";π7090  PRINT "THAT LEADS DIRECTLY TO THE MAIN REACTOR.";π7100  PRINT "SINCE IT IS AN EMERGENCY THERMAL PORT IN";π7110  PRINT "CASE THE REACTOR OVERHEATS, IT COULD NOT";π7120  PRINT "BE SHIELDED."π7130  PRINTπ7140  INPUT "     (PRESS ENTER  TO  CONTINUE)", B$π7150  CLSπ7160  PRINTπ7170  PRINT "    IF YOU CAN  SLIP YOUR  SMALL FIGHTER";π7180  PRINT "PAST THE  DEATH STAR'S DEFENSES AND MAKE";π7190  PRINT "A DIRECT HIT ON THE THERMAL EXHAUST PORT";π7200  PRINT "WITH  A  TORPEDO, THERE IS A CHANCE THAT";π7210  PRINT "THE  TORPEDO  WILL   PENETRATE  TO   THE";π7220  PRINT "MAIN REACTOR AND START A CHAIN REACTION,";π7230  PRINT "DESTROYING THE DEATH STAR."π7240  PRINTπ7250  PRINT "    IT IS A SLIM  CHANCE,  BUT IT IS THE";π7260  PRINT "ONLY  HOPE  THE  REPUBLIC HAS.   OBI-WAN";π7270  PRINT "PO, YOU  CAN  EXPECT  THE";π7840  PRINT "ENEMY TO TAKE EVASIVE ACTION."π7850  PRINTπ7860  PRINT "    WHEN SELECTING THE SKILL LEVEL, 0 IS";π7870  PRINT "THE EASIEST  GAME AND 3 IS THE  HARDEST.";π7880  PRINT "SKILL LEVEL  0  PROVIDES THE BEST CHANCE";π7890  PRINT "OF BEING  MISSED BY THE  FIGHTERS AND OF";π7900  PRINT "HITTING  THE DEATH STAR.  LEVEL  0  ALSO";π7910  PRINT "PROVIDES  THE LARGEST  TIME LIMIT BEFORE";π7920  PRINT "THE DEATH STAR DESTROYS THE REBEL BASE."π7930  PRINTπ7940  PRINTπ7950  INPUT "PRESS ENTER FOR  TAKE-OFF", B$π7960  CLSπ7970  PRINT "****************************************"π7980  PRINTπ7990  PRINT "    MAY  THE  FORCE  BE  WITH  YOU"π8000  PRINTπ8010  PRINT "****************************************"π8020  PLAY "L1 N0": PLAY "L1 N0"π8030   GOTO 1300ππ[e-mail]         RPG GAME ENGINE                alt.games.final-fantasy        06/23/95 (10:00)       QB, QBasic, PDS        344  22731    QBRPG.BAS   '>>> Page 1 of RPG.ZIP begins here. TYPE:BINAA TLEN:16712πDEFINT A-Z:DIM SHARED K,S,B&,Z&:V1 'Created by PostIt! 7.1πSUB V1:OPEN "O",1,"RPG.ZIP",4^6:Z&=16712:?STRING$(50,177);πU"%up()%9%%%7-%&u7VD[b9v#Qe%%%ed%&%,%%%%wu%lSgfOxeL:n*##KNYFmVlxIπU"56\:-(J,[g_nKG'e<G]2*?sA84tD0_?8/QYrXL?Pc.i8,L&>mbJ*TeI$HR([KCJπU"&z&&NXzz9HW5pbUVX\;;AgJ6JlI8EoQp?(+KLf?Okjzg#cr4vebYY,%v9dA0?YJπU"ZCqmk0]UdqbmYp[<UUmk3m%2Q0OUN^V/L_i1.Hs#[etQhUoGMrPA;im\cqns6NOπU"x&XrX=P0Q0W+T?R)l,Qk;YS*SF-HU\hoUo,vot'x[uQ<tQZ2EK3[h\Em]CR3,ZgπU"Rs4hrI]A$RotUG;ibQPVQEgMrH6%hM070vvQhtn6svhZqZa_mS;+.6L/Oj7a_W1πU"owt^x6xox=CTCUrBA^85CjT2aSD*[&_fT.x&$8Ro6we0efbgE[rX]<Qo[:3HD^FπU"H4vK&nE[.pBVJAaH&o^>oJ'D0MOd_/HqqC$V2IGh'p[r]94?eEbksvEZOCk67f_πU"DmKD$t8&t,hPFfNQWc.U-M$Rz3SijjO^A_4e;*VUJLxNOs?26>eY.8vAM#CMIu+πU"6n/utgm[\eABu(<Kd^X$3ga)FnSs&=tTT-AFQrVb(U6cmwLRuF+JvBdb(EQlbgCπU"+LJM>oEMRFk4U3Z*[EmT,q:UPh3mS\$BJsRVTfFuj\6cKr1_RvKpQik)5CaR_3lπU"LLjUc$VYjapK&0h?sn=C;%EA3\mlGa#ApO%Et+A>J^%\Yx^_F0;Hf?Cpe8>3c_GπU"[t[g9h6jJNAP-\o;Cf?SCAJ1$>]wsUJh6t/0v%LB<Ub6UjbV8DGfK]*UrQ0nJ4gπU"u)^ZQy]rY0LmfSxv5W?rM8-+kVI>Wo4+5#YA,zu$F\yQ,kQ(RG1Fm]W>YbbmUEJπU"4z_-Q>WeAA0rpBQ7Dr<JW<]'ahC-<C$>vfWL=ZBVW[7T?fud+5:W-=v34&)b3ofπU"MQ]eV6%l?%5,WhLDS%=F6Le5gdlH%Y,32aVk'76L9t6f:j-^oW.jNdE>CGk<p3gπU"LWCo_Xg+e[MCK%'Kj7KtjOPoTc]DbCJxA?A3w;7g%dLCcQwA-Z?J[i&;^hH$3VCπU"]h2U3$&T;<2m>lOtZq_AM?l(g9]qXNbJ']lkR>L'inqS'hG_O]G1KxLIKCrDnV8πU"g_gI4623cs35Op8]R>gxi$paInfAawq,duAfIX.%kc1'kZK[a[1J6*MX1kr?elLπU"T?m(eEDl)R1\$,\\,o%L/Kdd.4bBtae\Ra'O.#'Ub?^1XMmv#?$nL5[[PXf\[tZπU"VCeKbLFl537\pre'1D1XS^iRg4dvJ;??rZZDm30Xdx=(\3]$eo]-tlI+zQl;b\bπU"PA%bbL\UD'w*pclt4tM&+$ljhPugSv#X8M92[I&ch:+7un6^^ZWXDKDEN,oZmf0πU"u7]L1vyh^m3ZgF(Ulj48M6v]S[,w=UxO#R6*qy_ZBdVu(lyQFSb7X<+9dc[nDD$πU"cac/C#_tDD\$3^vV6#sz0a>cc/Bdc[D1D*DDj<JJ,ACAs-'h+%Z>h,x0Ta\((7JπU"bk566W<h*FbQAr:7nAp]M6d#,[2idRKC0]g6D=4i\?qt.hORKPMMsZj'XQayQafπU"e%ba<Tf2<CDiT>3]N=A\t6AY=]0fWc9lT\.2r_]CRl;gG:WjKc6)\$6hLsrRV3&πU"KoeBrS^Hi(6?HW+pnE;+aLMWbv'e_>V)>oUJ99cf#00?=v=N?#atZ,Q;MbqZ((BπU"$Yp2*w4A3.kY34=&26ICWtD5gFr-%JI=:xfigUB>c?i)0esaLGig[Ob]XQY*K0IπU"]T\r<9FP8.X:2oLe'gx]?oJct3r64HbNT*GQuUW+#uwoOFWBD0J[fOBkurmffj,πU"K1X4sG=mkVUK2Q2fmZ[xnmghbcKuqAJ=T4Ve4Y_4;C*l$2&u<nLl4StT<w)xN[wπU"IN/O)k'dpYtNdYE$6e)0jwPxBeI-Pw\,2RY:?HqJoI2H(:mSx]liF9cP_\&$<ruπU"I#2FO\64?kFBca?kInN4V8u=IndKd2fu<u4i2O1fU>nIRrDRf6miHmPB0>avn,ZπU"]X<Fl\Z:Ol]p6VYZ,LZrne^3ur0bQ3/$e3cM9gTVK?(RIHKy>fRs9-OYPO=_p.)πU"8=932;r-PF:9xnIR:b^%,2,_Y(d_4ZYn.1v#V]9Xi_3%3d=Z:x$X4V_5,\JiB2CπU"lpPfY0,3Yct_Ush0b[c_>(_o((vp$IDQB#DTdkPDP*$aB8ppu,i4g?kNoOQePQ.πU":',R%t)9(DiBuK(iHXQFK:TT=e<%<wZxRIj?j67qU[<r>9Vt7zr(yBX;D8xbsSxπU"3\<+T?sG:>o%i*7:sgP7&OYov5)0wL]pUJ8j*M*25j2:(ehf4k3&N1emlQ7x?JVπU"#Ij-57i.]S3BTQFJi7Cg.aT9SP1G5s-2K%.W6aoE#'=EmNw7=9[sBk*+YPLXw9+πU":3\cX0gJ&5ZB*i3e=me/7,.lWT6CG9RU\a,XJB:BDVn1D'KBjcQ6=eyS-hP[hRJπU"'H<Pdl_zrZZIDptW>=Z(0mMnbvhaCozl#Mx7e2n;cilNizU#p6MV[<Ur%u=vp%vπU"E?5NiMzig^h\vPU0QPh,nAj%?dPj)?fb7p7L9BRxep]6&aVOVa2.AAU$4T4Vtr,πU"(+:v_ezrMnNiR/[IN-O9-A8No$JX\q,#g1qT-jAWX-F7Z*'f:DWn:zSjqT*d(LPπU"nJ\m*P&\B42X=V_.JSqu^aucHmsm'ipc9lDA9a68pu^[Bh22MW)(>1JTxU>6N.oπU"PMafH$SI33]RE#k_%z+2ATtzqv8w+k>KZ999P2E&/i-3<>Nf9o^GL&7];)mcc=&πU"(:WA7]m%^^K0Nf/AI'U4m7&&,&bl=lS??EIqRj2wdefNtQPy67/<f9KwqJQxC*:πU"''RS??aBc8I^1_v/z)SvfShT%Y%nIy2;0O3?Oav'_6-[+?k<2pM]^=fF3bd4HOrπU"8oBNeRRE$h-QYL&,.m$ju:m]AEY-/Rx#:bzeaD),Lj3Hac'k-VQ>-XcJ]T_twF&πU"8V=2kN1__#;#3si38PuD?EVU^J.A?]2?HSQDe;yWrNXqPnvx:lqFVd^tvD4m<ICπU"a6q>T[lnh9a.KwH;<Yl-\qPm4'Yk>paY)_(kZ>>nI6Is8NSCpCuN^O=q<Xe\<FhπU"$FY4]DoV=L3&/'I^sp3]\tu61+FgR<I/sXRf/'s*65^\&h<YS&e(2'uu_Gemd/XπU"9:7F4fYI[tB]Vqr\3[Jmrwmo+2xs:9?xsLqWOPn^A:9'Z)r)3%G4Pq5:rh,-IM2πU"/40P1k25Pe5YF><(UXf^MA#%*k9u2s$d>Y+$m7aZAVgGMcW.Ooi$-#mNqONBUcmπU"aijYM_Ko3#=snk\3$/_O3U+V*JGolEp395bC-]U6jA]+.%Lr>GrK(VApN&QbOHeπU";TJx1geafamS(>%O'bF6j,9]ChTG=oc(&S>>-FK,7u>9Jq[u(BH[;IILSvIfJ]iπU"J0h9hbWpK;B>67ap<N_G?V?\vn7<K$GhhXG;q_oU3b[EF7iUJCYP+Uhk^_O.MZOπU"0TXv?4lj>FCy/_Z^W-F?&4d?V[SC>EbP?2hOkm_KjCKc7_hAV7DntXARWo;VDNqπU"7qgNXujMj[[6]6FngS(J9VrT2UX0FW]McV2>,6]GW,DK&meFUOC'cvATVKdTsfdπU"IHa=19&P:VOl;nT;NZaVtLL](0A$q9?Q$q346bMVU9w:W??96EW_aL%XKtnnik%πU"u0iS$qTks;g6_'76dJx7WFFMBIJXkMWEs#]hHI7loMIvsnXe^:Tc_i5C(U,wwCwπU"gdN*cET_W]AqY1mx$FD?#\q\_G]If^e&^'Vx<m\'RD2eR8l7FGh8%o:QJiCuTCGπU"X#WJ0a9p.mX>o:/AJX/L$ud+64?J?o5TU(VR>O7n/[nnsP7Un90iIUs#*JKL:WiπU"nCR1JiKWb_0+R'EJTClmMCT>&Fo%q'cxT/u9n-HAi5kO-&YA92*$k_ZvYhF9IRlπU"#LZp1BAHtGIBQ4N%na?ruYvv/<[4*8VVg0*LSzB+am=FezLX+D]61R*+NU\(IrcπU"9iru.Kr?eAlTU1BQ[sbc/OjDZ+;8HUv*G7+t_y-_]Vep5h\Yo?R]8VG8aps0agDπU"fn'h>-([K\C4(MayBmS.&Vb$HMP^W8Y%?_Q2:n/ES/?U%Fxc^b+2<(NTT\kbiFwπU"W^BMviUJ+,&C(X9bO9)>scH^E?=772.,(P:0?%AC*oUYX4(v3=%kV^4nr6D5XsgπU"ac>LWGwt?Gx9[/'3qaI>f-OAn;2*Qlj>PoKgL?-rsE.yX/]+Nj?W\r3;s%G<9OZπU"K/+X_4xRJY/OF5k9^wP%?ru-gyi-40gz:Rak)wjocr(R51x)2PeR=J;<ZO8[2LnπU"uhLg]Rg(F,t)Makb?NJv;ZiSoQCod85*=OiBFm/>r$Nu<MV00nDf4g$ePN,-08'πU":Gg.u<nKkXvx<k.o':<e[:\P,DNe;Q[:vMaLO6a]t]fr:.fXp21^WlRImYuD&TZπU"AB]?#WAJC6Q#iPy%S(mv.dAL3gDD:tP-w&CZ;3Wn?sKD'#AGO-j2wpG9ehdfm[,πU"Za<i+^Im=QtXDc%PD%tn0kIe2m[^)w-aVo9J\J8_'+VuF5NR3MqUWC)6TnGN5x\πU"Y6PkEmo:rMGVd%HnYY)22NL4\k^ybJPTisKGP9yreZ_Ju\(GT41QeEN[>o)J%npπU"<5)Qq<ewSPaaZdu'X7-q*Q&D=2TpJ:^'n0ucM6zT4*#Ln4D5bN5=AwMO?+T*OnlπU"iR[LakCcto_duXAF$)$+Bww#XdZ.R6'tD'xe_,,U([ge(.n>H#HjSpa0dRK:7hzπU"sggq\gHV$>8cF]orY_F+Coj7?j2]Vq<B&SNMtAe;9s+KUn6HQmJ4'h*&w=Ftn.gπU"G$915UZlkm<KIjN$H22-6>actD]M3/911FW5E>Y7>G9H4f79kZA02Fm6nBvyzdKπU"lR7&.?C:_?DVPR\Sxqe_B8t#sJ%n<.5E?*sCV8'rrrDs2dd[XHskx#OJ80S&.^'πU"^.^6n/^fN5w\$lu]Ak-DZ1-WPG^g$J$+t'O=A0xNdqc/vmSYwSwqS>9KU?d/bAZπU"-*Y+-Z<\8QjSg%E^)G?4Q3-1/W_r#oU=yC0):ATMfPR;'LONLJZc1\8n$]2N]NRπU"q:8q6igmbPa\0l0(5VQ<]coJ8H45KRG_umKa-<uf5_LFWae>EU.Hd$/u2vI64EVπU".t\>FiCcoOjp-PT3^K2a2WbM6hGRsT33l0[$ClW:=Nh>JscHh*L^sA8TW-K2Q6bπU"6t&<]5a^30f7nbM<>,,Uhc-l8Zp?zB0HsXdNJL?LP&Nw6VW]+ZfL#3/e'3o0YYDπU"m=c9Z]-Ub5.%6lbkpF+9r#o;+#[MO/Yu]<ndiVo-TA2.Lf_&.m<)R?5\t6VgNNoπU"%NK<pium#sTcEu85g]+g#UM+lq-:g]qJj\%-p/AP3+&a?*p0R,)9oSBCRQ(SGy0πU"?o]hV:kyn3sIjh70Ho2>hPH'a(,]wj4MuJh,/MUkLr3;>6bc&z\R+fVUHDW5^Z^πU")n_Kb_ksFw#*;=%oueTbsg7Mg_5/q)9rKon_br4W7\,z=Oppyk*he\3P7K3mmuZπU"34OG&FzvqCe[dy[3pXoYlvRV]G*eie+lH7ccCEjb-kmLWRS#]oJrT]1z=A[NWF>πU"(ql*e2F&va7$0(3=2\$g^qsUYvR8gKosC23bi+AB24a%]l8]SW;:5H-FP^uIHJ\πU")%4pjEH3sL0]]*aupekuT*ubzX6<5IWRS-YPfwGC7PI5(pYA?Mnq2G_)#yD8zfTπU"\FceQRLcMF-W,x9DP).]t.9jp<Uofa>3Tc:NT*q&^A%=L3I-tzoTLnn8yLY\E'0πU"6<\(J0IV]ICE:SOOz8_KU#UopuKc#IHbK)w&L(A^GXK3_%cB./12_7iqoqro,63πU"NRpwd6h>l<wCs3,_7LztUA7u5.oT47es.Lj,$&dSC:ov&f:6jSANKPC#XLN?,'1πU"o%W,kWt.&8'[LD<WdW6doUt$6%P&?oqgdfRgB(t:PW'os[(6V;raa[iPdM##TG*πU"26&R:HGmHPngW][I[d;Kj=,;5Dv.?7oE.>MfB?,ev2;7&&7yGAOg)BZgXduJN_dπU"OdeD3uJ),-ut_5#WCFp5eezY1;.]1Tm5J#7D1'cfn[a.fENS'.WfdW8_)ID6C3=πU"R^k)QIQ8bag%62g&xm8cX*6kfS3_[%IPZ]6R;BLuy,akZ?38u/rNTp_O%g=V\M)πU"vaQq6,]mJmh)KR8,,h=\Zl08*FJA-\/n[A5E&rl39VjagR+MmcALUecp<jAV>kYπU"Acc30T#h-[h?eOp_Tk#XRa\M8X8F\N8rX;0/l0=bQG=P$i%)a[jIdCSF/yHr&DzπU"^O_T6tSQ50,H;qS'_W/m^U:V$yscZ,lw9]$DWOnmfoqEo*Q2)qD(4p?D5as2rqcπU"P_0fy$ZL+f7Mq9/LCBVy)U-_(1cQr-qnti?Yd^A8M\2%o5jl>r1-%gtkzhD/f09πU"^[0l%GbDLv^fR,%n':TpWQCw>zYlMpBM.#[DDdx4iI^hGrr<,.VXU'<QRueekkqπU"YK31RbbD0ci6f'RYV/G<\DIv8+ANFmCGr:h9/]GVjg\>Y>bY])q4jp2qofBF9=#πU"fd%An7KL2=\SfTB[Fe%uMq%Vj;a=uLRuvkv>9W3cxj:J$eg3_zvI4d#R11%ntsEπU"FP4[Q6kC*GfBz:&(HD)D\4o>956JUgA[C,o^ozAVh\Uh.$,BklV=4r^A<1SJjCMπU"MAq$blbo%preu46unwko>a]$i0L1wDC9d1'rJR[85z]d?[#9&n1^ijT?BeFH4JLπU";[97#JcShr9e,Tm=Ls(GBZp3a.X1W6DrK[xKnbsRQ_\%_Cht&Um;NaKU+'<hW?DπU"6V$i=4'Mv.U*ts)/c_B9KDXJ\uHO*Opcnb,h);EGra&;X,YOGO&p4UR(U;WH2b'πU"9XyJbfWj2HVSgBE\d>%_*S9)ebSIjnERFtll:tYq:(&u8.4[cKo&f1heuUBUSmYπU"?Wvi6NwW\R_.cPcDc,84&Jp*n,C>;XvJX*..alb98=s59f&,/Y7C#IBMlN6(j3fπU"?-*6ZUwtNHp_vR_BIz(,gXxAVU<b2[&^P*5MWmNCfj[n<+/wfsNr1R>4P4SCmpPπU"41U=$7Z1bBd<SK?&f=m&Tejwp4S,_#D;2,ZLC>w)<_4]v5ON+%,xHAuo<J<B(z5πU"mP$:JAzK88Mq<?(Yc#,?r\R\$P8g9J7Fy\19i9&7DtA4&y>vM]t3v&T;mjT9ZGZπU"hs.?Moa;Whj<;$ot(2c+?.?Rs0K_o1MMcal5>psL&&zEdsfc9MkZZ#Ck+/<mD5wπU"eHGLqFp8+u_X4iGqraSJ.BfE7ieVT](8%,xAN++N*[:3#P_fFn6&_tupaC]=y;=πU"keWRI7/W:')BQNjOCWb>CMra:_'9uWptI>>Lg:AhGtpgh6GINu9SM,$k$lSY[rOπU"FIm#Mq*[zyjp+A4Be4zX*#^?ENoeJN%\mY_OT(L%HY4$ql;PzZ*lrk-16jJ\_dbπU"HR\d6NCM\Qqf0s/D?Db#BZPWs<+H:?qEcmC<9#^tN0.7htB$V]&z8l>y/P#+Z[AπU"#$WT(>hL_rC/DZv<?04P<V>PUF3%MJBE+?Jj+6;ZR\EB<6>aJ-1kEBS\o(wM^q*πU")(-K2y.gjojx0o;Z_([eBuhD_.L^^NK,&WXt1'M4HIy^<Ol#s\4eT>mIqoMgn;gπU"s(o*65tAXtrI<7cG_HlvQ0]NLbw7bk(mzhSLdXvislucoVeI%JF'D_G+.S:(E>$πU"1\$3mwsO('e%q&=vjeo<6rj+%&=n)v*/1NOYls.D[(=9)kf,[sJ'+:747cI3IrSπU"4dP6^OuqN_L(&u7z*d92/9AE'7:pa'YJC+MD%kG^,SjQaHNbQ5s;z/.izNI6aZOπU"MB3E7bNwbjec'0rHL29y+:ug[p4,2B>RR9_7OS7#mJ3RDnqcGsia'6x9tok=1LNπU"C[KgJN/bQ)BDF=*mKM6A)e;k.V/Wun;7Q36-aerWxMf.FP.pp+_GD7?bG6$6OThπU"$a]+HA'J)Z18VK3-coJZ&mh[A#afu.:_G7z3$K=,(7Liv?r\3,-ebAa^h$tZ&CoπU"xV5(<9IE0?Zs'H5Eo/vFna9QQ^eq/9*:hGY6'0_U7uR%*v40T*)R>O;TukK8?<kπU"wccjsONqo,oV;z\9RvM(#B.R74f]dIvK4J\hZSTd[ANNd<T-:i?Z&)cR[:uW6GvπU"Dm<T%Xpl6nu>;nEPH.JAck1gz.nq'1iS=o&#DJYkCbP%_;K-D0Z(OdTc-p.-)GoπU"7YQ$:oM^\<)RVL)c]C=8)>:V>PkHGvZ*BVhiP4.?%HD,a<-)4++sXg%PHF7yN7aπU"6WCF(.GrP&p2;_e)FD?=hjM/l26cnKOD*&YWg3(9r*&FB+38L9W83DTaH2h(1*,πU"TF=>Kh/4ZRw_YtQ.+bDiUBS,4$.N19xXhv(aKZW)p)H5eplKHIsh>u^b>?'/v_-πU"8\%*tVXKsFc&4CYQAd2\#Xu5m/XC8546+;&o2+^$v%*V.sp\Gk+)g4_rF5mMDvRπU"y]CJMLL2e>0gBF^GIRIM%+<B+L<)?'d_,'MuamHxJn?e.YC_,Ftp/aKPu%?rJ-tπU"L8lmbis,7Pw.Pl[tu65zXwfuwnbuBCv6mh+%^TO4Pfn[BZ6bp+z3-BoZyJFaGQ4πU"$1,xR5plD;s<ZiW_;22ih'EXxH1jBMubYjM1i[Z\GfgWtgo/K[49vdP4wi]u<V%πU"/>%,//0]Jmt^lgRBgdws9XSi8U[Dj(W;OI\9ph5MHFQo8t[):NaLe=>BtO22g#-πU"rB*rOFC:h>gG,VV\6JLm=Tko4ET*3^'d3'ap>r#(^KPgYT064F&,wuaF0K[htCsπU":5W'9naT72L=&Fqc*O&B)S]Ei\+hj$o8R;A*io3g)=O:gPc02/I+;RjA2nB3F,PπU"45G'C],L0$3u:15wxjDq)g1Fjn/7gzzI)ZJBf5QO&m7W&)gIgkn*d2]<^WK7VU#πU"Hq=5oPj<6,$UN$,n^4US44qn'?x(A<G4.fU3;6+':wM&n<W.6GJ>8=3%&VzCU-SπU"cO#E4+A5_=#m++JHJ.v+%=#%1ldtFPVgjdPE_2(57vt_8cIk)wA#=u&dBaGU.t>πU"K+.\\$s52nxUK$9Pa<uGC,p1>[aqi[*^,uMI('j#.h3e2YIkVU&SmQn-I0)rte^πU"2#kz;8A9G5&s8O3'kZ(r;SN0FqcD8,o?k+r+t/N3CpoHj;Qc\yrmJHQTnCN.2P4πU"5LRCJ9b=<jq]p8:7,EbhloB^WsuU.pueS<+s#l#h]-r<Q..1[:5_^'LDrln^HJbπU"5k\^t-or&-mK>FOZ+j$Qn'Wu=gJ:/?/.j[d\0W0dU(kQv=5f#b4'#zlGoh09Br6πU"-w_M0)k-jM;a3GU_K0E4Q'O$,0MjmGUSb\FC#YNBZ(0*$K*9DJ8TiuBV_W?k[0(πU">;cQMR\U4PDL0(tL:)]R?D#wZ-O5i)B';e)%\pYXQT20crkJJ[VEH$/OQ.7qL:uπU"rMuBXVp%(1[QF[>0690t7RY5>/byCG)_O:B<b$$gB#1(:QKnG&>-2,gkEA7P-iGπU"S%fU_JZ&0W'O-bZ,qi$k,e>Z.'7G\i.AE_MTr9;95jqLx,JupN<;F:Ka9q>(N+NπU"P:,XuJ7X[;rLE,w,GY:Ac]2*'6*T<Ht*V9Q?$sq[<)7V(Ys:loGa4sB/+1AuHW-πU"?y)1,f:nx]'Y#E=>SOFTthgl9?neuqXotSb&uV=,5h3]n;'Tc?IqA0(]>6PEl?eπU"FYzOPeWtX2)z(+5Rw7to;$$J5Cs9lo9$gXW%yuod[9grLoV.z<jE$S28+VV/)9eπU"J?e</p]:Eqn2aQ4^o/Jx/YEWg]?/u7>9QSWOVZ9Y*q.-#;u.(uknlYl-US]PtNjπU"[z2e4>8g,].NA8MOWC):Zn\sbtwQ]IQ&WKq+(ph]cl$quFA;#a;Vv>J*22ke_q+πU"cdk0T?^p-g=J-Dc:Em^PrLJtRXAEl=stH4P3T*ndhkmD>d(Pe$ff8TMUFn4/(6hπU"DK58qCA55RWgSsL01JxNuS2Q5w3I<H\kpkwgT_Me2*9Xx'FYdf&-qkt[/O%oDrCπU"IHm8d-xM61G<&_=i;i4u]xHaM:G32,QK%(qi-38+Gc^E/Dh,O)^F6B*nf.iKo'NπU"h)C%-l?spwF:7x%Pq$bLd\bXkS/>y3R9qS6+*.xC?(Jp4_jR7Fp)*D..2mx&l#UπU"K)I-&>8ZTt:%TNE&e>*gj2RM^K,(_PazkaBeAk5d][eDcOwW)6E->rHVeGJJnaIπU"\3CyuWCm4>ZMNGPI(n^iH1XpGs00>Knv8SKMTvv[]Ji3k-U$jgt]q+(=F'4lP>BπU",c(rq^BX.^6MtQd62'k.(Lj>;Le:</k1JJTcq[NO8&l3oF,*jM^_cTN*e6RRHGEπU"A)nk3/S7BFst38_nV8+X03_-7WoKJP1g_b9,#KVNC8%<e\L<_&8[3LQQgkZg2K5πU";QBd,$c&&zM1ItXmU#oMqRFM,s1vq21VOUrFs5trbZTP4YmalUlXI%U;tp<Ih9cπU"U-XuX:J+Z)'S>AB*bV3sDvq5XX;=\w8(^=<mW?Kc6Q1Kx'NGa9i$q$LRdvkl[<(πU"=e(O2KsNOM3Oo<#?K9v1n?DDq:kOw3NA#v(RK-XORC&F2X2QCXDq4EXF.ljErw$πU",6C79%mn*_o.?\#'W6);v1A=RA1oFiG1PAWz\5x<X&Q?DKJG:*IJaFsCfCj8T6hπU"O5aqigGco$-ye^g*%-NNCz)HS<P(5ZLmF9E9z'2VlLeHX':\OfD2o..B=l(/.RpπU"a$IMUAjabiW_^7tS[gZj9O8D\,OxAJCCZSdfqg*j?B8.OtI_/-0HS/$m)3Z8-Z$πU"x&l_nD<u9g$Kb?83vg?7tgPA.t:^u#5wCi/^QP,pfqPZG?SJVv=5FoS:e64x#iWπU"GpmotVNwN:)zJ_-PQCfLdnb%&8?+[qVf9xwkk\jAo)'g]+aaQ-&f04CGVQ/n:88πU"(QT?**EFV/?pIdCs?;::GN?K<p$H)H[fH#5QDZr(H/g7dn-EYoJbQ=Bs7OQuRA0πU"\Zw:EDbtuhJq0Ulg/z%:sdf%h,#?Z66iLwaUMh_9L*<aWa1U0L1,SA).;SJ<*VeπU"21XGBg>M_%y_c8FH<wPa2Gg;*qawDj\Oc$0_M[a3qr%BfM)]kA^ootsgbntq\L8πU"vwS[LFvtL>u#g%1b/Y<^Y6VX5b?Vg7^54%q.(XJn)b]_YagW2[AtT^cqFV,dl8lπU"[2tADnk;8^e3v?TnesRf63D6$hn(?QT/'Pc7^rP_6SsO,EHFRKCpKL\FH%bVNB$πU"wlD)DFvr6\DIZW,DY)7gGq-Ux209C^WSXP'BYodlLt^6F%&,w)khfT&(g^-'_S[πU"7=YXACJ+qRkPa5(14$s*AD]%6jZpx\bhDWf4V\+EL#W2+>AIlV/-JgA5Ul=?U;YπU"pL(v_oINaZ9rKZ_9cH&9^-w5t4Um_?l;f$VL[&;WRi=tf(#n^\g=Al+&XwfAYLAπU"it/'=0F[79/SiFTdJ<1x[K&W>U^/60g4*P#x*gcC?gf[$;XS(=T5>]\5G\1^Yh$πU"]?Fi?:MOg=\T5>\.5G2A1e&(hVTr$C-&$)CcA>(:Qwv1r3<gTyUSVkwI)TppSErπU"HA3JAUQ/'wxgfi_&YkQSa91*9:XemhDe4*Mm\tmb*,6wW8_Arg:X9pr\5_%s$gfπU"'L6B-5GwAnRQ>gWoe3&/zmL.SltIb.1?sGI21$voHEC?i4Rp5PKZy<rr3.;1%(lπU"mcn5%,&FoQr'af58?sd78&'hpK*FF\aEU;HuS,ENQQ(PYeo-#I=352_Z.FX24OPπU";L7.L:2x,y([j],N1j5H92f8wk;Sh7B=,>*&ivB(<9$)6fO\68kItTS7l8C.7mZπU">(fkJ3&O^wfsJh6)t0D<n96/#;*0#cU=U8P)oB#xK6pUKnH2%r%uL(,R8jF0eVaπU"W.Cw=CM[8*OWP3_R'%2:#%<-vi>^TY)+gzo#x\]46Ptt/GeQQ2nr*q'G^+G]:QAπU"A$)V*Nb(Q'5XvB8:BFWOID#5dg,2QS9lfbg/oHn'?I?J8R>FPU\9qIWPVv?Osr/πU"jJT9d?f;c3$CDt.e4C>p*irGIjf7(*)rqPTeBWLNh)U^vaaE\*2Fps023]JnK;2πU"ajX4wqCdg#$.;]jIo<9bF0E)MYkH^(KlB78QwN8L/LcWfBC?:5K^%%3>EhbGYvSπU"G7XH0BULhg1brgF:Fb]F&R%Rv/AtUn'EmW%H?a(2i1n[:$I'sl<?Q_yBK*gcBUiπU"NFh*3.?%v+-gmerDisM(pVaxDlVR6x,X(*)QrfsFal0REhG(x7ML$I&UFggPuZbπU"3J?,c.5eZS(m3rmcrl^'N\Ot57m4f1l#nq.8=uxLMZ+.E664RCMu10)k_f]MuVVπU"Vf3._,BTQH.mSd:QaH6IG)qGk^O.iE'%%3OX:dCwbAZK5N)E9+4N$98s)(s3QJXπU"YZrae_zUa$5ukmYqw2ARH>rbPc\FL5)3pt$+X)UW4\riuu\EfT/40r%;I1l[ibHπU"t[oC&irA,so(8g.roD<6$On#gQ.ok??(.5HEnGVpfby#0$6D>pTa6Q0_([(Ei,JπU"AFPFR4q(S<3\,oWdE)%kpYRSTXMDP+ab5hUz612vc-#pW7QH>DIX#$$OM(JTfG;πU"Qz;K9K),QP3i*2Cl-uU.9MsAsN2d.sf^bQH3Akf=e3cQh<.[Vj/+peGT*j>s=gZπU"VScVeBU&9:8KSf:J;:_URko8kVh-nm8uW626,M6P'KX_7?C.XSDuO6Q^Z1A\*lJπU"SxeDOY&mm9xk:p/Vs<%j'S_hRn_2kwQBZZr>%\R=cX#n.abMl6U<YV.7Gx,MV^,πEND SUBπSUB V2πU"Trdo_Q2]yh7)4S;8]L'nfxELW^/l:S]CHO-[VWbg&h;Qhl;JdVf2,Gi_XCcs%o=πU"%(:xHGv4>uox-an=n/kal(iEykcf[3Eqi^RzYHCK6pk6M)Yn[whSWZdGZRV.L#VπU"aE%lMQmRyfku0F=8Nk^OmM0lanAe_;5pc+$,_KkiPhUwqmEw1V8v3;ZSJ0:cD_CπU"gQd_mNaEdPH1fPJ3\Ase.848I_o,tbM(8crbc.NxHWPu0K+O,sJA5+$l$kb]2iuπU"wQxuT\\>Z:xnE_'7d2SIlhR#0laBj:p6QNn?lHiGmui\1FlwhafGrTH[-x2=17xπU"RPX-xAA\SvPpFJi,xpFSW,g]P6:^$h9mNrsC$%ZdU<wEy]CAp=.eB%U&5EV(DT)πU"jwf\eqOLI9,p9C(-Or0u)dC/*'w0+#ae%Xle:BXu)i7[&FfIp77:H_r6,aVIwqbπU"<FcH>&^t:7J[XK8o=Y%)PUUIRY,7aGn(*G1;4Y&n.0IPp73R3\KJf8h]_DZh)MMπU"VLEjad*mKRchM6s)6.iKRCbMTtrI*3D1MCxGKM9)u'\M/7*=CCn+II'a:3Df(+RπU"6epM^4:3FJ3eZig5gGeq,\(et<7b%.-rg..UwVbO/?fs/8?<LNx;.3^^&=tAQ:AπU"2EBMT5N9Z(g[M8_5.h\%hw]AgK]x2\5*3?l4Ww1-'fRIy%_-Pe8'A11+r7*gKZzπU",tdZ:%TV(%F(&%&.oF7Po#O[M#=VLB(Sh>bdn_v'Jp(aPJgXe4lohBGs]$v<P\JπU"8dr(3\qHEoGz0HH[KzFexnn(2-=fPo6R[:HpA&N;TY:u<XstxqBTtLA3ArlW/95πU"NqX+.t^jKzODD)'>+JW69$'E^+Pkg?l+PQ(tdK$>,Pf2=8H5.bmiOX520]k+##\πU"^\<:^Fje>jO]Rbf]PmMGvT&?q:jWSOLw4WHUY%7\*)%fW47:,9dA0sf;&?eAH?QπU"\t+8v)J3w:no<>&Yy*(g]n0qR_/gDm]Cl,h#pm_/]*]R3[*FSZK:&:GlA.u4)TeπU"Uw\UuMZiml_6sW56PZ_qvJ3,A?5-o$e+=%YH,X],*qN*p$^/0K.Wn0H_2NU]#j:πU"A*.kt(e:'nGC9?c.A/U^J[d\7uwtOhVa)rGp]Y]'+MAju8LpZVg)4qirK]'Q_,cπU"UZiw3,,e%S(Lyw*h=G56=Ae[QaBnX%quvED2'uo*q-<)N4(OyS0'K.2n\5W<d3qπU"S>BWS]0o^OfMnmwEwOkR;4\n(7oZ$7LEHb4[cmusa[fZ^rbNDDddxk41oW)yiIKπU"2?IoqQII<Wn<cDZ8t+CMuXWid6iV8;u?9#W&jB:s]-%8k*fz*yRhecufTfzZL'BπU"_:9ZW>bN/Ri.D#O^wcr1/S:meu4fXe/w.6i/EjUd?SCFKyg>KE+a0D-R?+IA'-&πU"TxpC(1BP3IJYMb/Z/YbCEt(sf(1?lD-,$>je.qqWf'Wbr[g,6AT9'9LLIv,MkiqπU"nNVhcy;CDuJ:?\;&:r.h'B5,EJE/bvme%hItEvJK?coC%TF7iF)=&a0IbsIG'O0πU"dsYM;IG\YJaw_f\.dVCa3zD6P-cg+r2^OO2\ZW>wFi7:Gw._iK)nP.=lj56&_fmπU"7Fe>\l1qi+)Kpu*WUH1qM?.X=9e;2(R7,G)C42ah1r0AT7&3]+Oq9URm62L.+nDπU"U1dky]]//T6A9QhTcWJ#[?(q&-e6:ko7%7w-I5B,Z5*fM'l%fvQd='&NpayX?J.πU"l_irbe,O319ljcH^l9UA[xo+P[NYGuV626Q5gabLM*kV2b]EZI3AjR<qPK.pr><πU"J?<0o3ZM3ob^Ut5#2AiT0V=y=<-%wnsB,\x2V\e=rC*S*G2ND77,XtlM3SfH?HSπU"Py4_]Ukbd3>eOEvUVJ^$s<9NcZ1^sGj&Ih:pWm64r_d:ygmPdLJ3K+t*nd9>Kv9πU"Gjmx30Kt$nad>Kv:9jm<1A$GqQ,3Y7G%mjAT]<U$5y',#Fyu^=4(/itXM.-mZ;KπU"j#m*DKg>0NW0EmIGg93ue*Hf.:Jjcp:*7ye/XLOnVGnOhX0h[rB$/.haf4#VFfMπU"<SAZlS9tg(/uNUe&Go<agow?)gZT_I<Fe?$ZekD4*YAi&DC<*CHQ)n%pPwk*r/iπU"u77(oI'8^Nn&-B%w7upv_muv1H9_)^PMVeD)rHpmTe'cGa*_kk'9^YwAI,4t:[yπU"oORSR0D[2]24r;29YnBFV<a-j#U+<YFSJghW',2aZeJ2LZ4U1Um3Bo8PA(KLHrgπU"Gu4ft6M<bt&fzb8Nkt)+PbS)3?b+l)2l>p_tnu?.J+A]pR_HdW)xr.l'pLcv2Y>πU"Qb2FrKg%='sPJ\BLO*v'&//[t]O6<J%O/e=9QgRCxxEE8-;p.r.Ba7mD):o<Is%πU",7i\h%Dl?8aXE&fjzrBO99.zHjk9-iIWAUR:?+oauw=>qR>-#p8QfVNZot_MACKπU"Qj3/A>h6Xm--,J=k/N4vwO+*VD]oW2=E4fXCc[TaZ4.=8*8enPKQt76<0$U(b%aπU"qa>Unv_$,9WDeMZRd'/<9k*pu5GQ*C/[A53fio1lP>=Kehk]Ns?K85A^Q7Fb->3πU"ua,JK7-E/I[r(JQ(mU$Ag4bSv=hp1\LYbMRFWHHI-J<_b38Rl1MfklcmX6OAtqIπU")1KHcvnW6K%0bZ8:#F,dJ'ox.0[V.>p+9EST.brUrg->dpSW1fVZFT2s./AT-TQπU"6[-ELT-IhGm8<F:=MbR%$^u<uZu[475b?.$*3x3u:6qs?fcQHH\U<,q[&x7==xlπU"Sc?rY/ZA;xojn%p$?)_sx2'28tZ$2U_?(IFzt%1BUKnajmQcl;IucH*bkx'<L0\πU"Y)RZWhTBd9QsOH>s&^pL9<jmi41E-V:$eop:aK82](#0#yp:nDRO26a?%*cdN+:πU"*&y2+b,([Ohsl&)k;Iz<u[]&,8cB)ZPB\HGuREfxUbBxTLqiA0nco&J0<fXRC_6πU":AB8L&^e>;axM:]K1[TGl=h(3:l.ukuKFobxbcH/QL;#UWi\'TZtpoubn*(1*w+πU"T0'^CtuFSQn6XMQ0>LKjWN9B)E*qeI1m3m65Nhz1D6-e-sNJ17/+\&C:<zr783YπU"PlR$TC'b,ohR.Q^1aOGaqm3R#tgjaDruDKG(NO&.'R<6grJcP3R-v/[GY.K?.[xπU"OF+>Sm;N%i)-Xq#vsCKk%-A*9<Q$WYefV>B;9(+Sp;?$vQ>8?]v7SF%$#7?;4wbπU"o3k:(*_OQtNSDh/(CLPus7(65Pi./[p'Vl\Grp2B:TIwgq/z^U:EabaAzzLzN2OπU"R_Dy.q[9<19b*[VPCpa&7id\<69ZC&_qL17+;4tk*a##h#Bfxep&U;Aa_%,PpR2πU"(Q4DL)t?t/ZFNi/GWhdQgBzg3:?Oi+F62*>q*Qw;CT0FPNKmX74^Q,a0of9<[7;πU"AfvD3$NtlNWA;Y(Y*sq\)pb>j0KnTku0n_o<8(o$NP&VcnP#Mccf>K>mHTIcp&oπU"ICD_8aq$awD2X#<o<]#e(#cXP7D/5z^3#1[3<.'Nkcy,v++)oUblgM+Gh%Q:Ir=πU"FQc*#BZaO73<F=jgT;,gVIyTWkP$XqJbE/]4PJs\1/eNVJ*ZOX4UbOxe-VG&qFRπU"YoZ=Z-,?lk[aq[1DA]K6Gbc]ekq[%cp^pAe6IdSQF&uf9=oA5[F0\iKtT>*R15NπU"6Lq]U,b2?0VaLla)Q3tY45AV4Hu?QR2H1X_uou;:h,kU>qpRw%S],e0a>+eTp:AπU"tP=9QZSc,m(?F?wpHQQT2.(a^^=#v]Nb-WIt1T=aAa<U$rmK0,R3mufw^?b\VC]πU"rNH/O-LAS=,;h:9NWqLL0^aT4U^[cUE=X^X=\3u4\heeXwdRjG86k2ZOP8#UM'%πU";lONGG/F.'RP'OlGOnG/9<.QMI'[lOoFGYH=/i$>&tVe:&0cO=/Drf$U/'9va/QπU"WWOO;L%S?\<39+1iig&mS\NBJm-[)/:I9&YNcWZp;K=c.r_N_QTBc$?.MtCa;bNπU"2#yqqkU$c)'L\sXrY-k(]^7,oXFru-oAKw*p3Bvb'da&Y.U-91B1m(F,f+vP,p?πU"/ss5I)DA+XbLY>OpITp,8%.=cw9D7)FXRe:A3P<1Te%P;0J^Sn%:UE5c&238j*GπU"'zV=;%]0m.4tR,R+e_cLlX1JGuPyUIRl?UCe?%90/ZYF]q4/c.Dtib0U\&.B9?'πU"&[x\FgD+$eARon>H-'RTKG'd*0ny/R<NFiL[/Q5cm5:%kPTFZmtiwS_U&/VmI\4πU"_8$dj,]O4$:iPTwT>)Mp*v>nQ60$,G[o7bG7)+kZX4sDl66*/vTgFEpLDdG5o.DπU"1/seU&SgUSHo++5?taABiB1u3H_MG%sUzMjLdS9mh(qjbC_&j?2sss7,p0,#rswπU"'ohK[w]Tom^[uIcpAd:aV9U8Pf]U7n#F6P?%>NF0*B%<C,$QGNT%I>Abb7$8PMZπU"Y-91]Z2Yd(Tr)).1f0R^mDrEg<E()dJ7sVt/.+Q2cGx,h;ZB:L^-57]h)JTn%kUπU"TDAX\FL4cFKD$KT7Ny/gKZP2B/jXl]=MCa*.MmPeqd&Qk3'*9Nl]vjJIT=&JV0pπU"((D%9'<nAEMC%gNRhD\j8w+-)EuQ.\^vFb[]DD'3bg]caU&rjS+;bb7'S%-8SVgπU"axFl5SX]LD+:aL+N[.LR8to92TZKh=aNYCrpgi1hjSvvR$a^rYp(Lt$$\LfITbMπU"llYj/S5mMKTT8>1m]>ltZag0a7W;K2mK0hI#F?4<H'D^&KDH;W34rn+VFQ+.l-oπU";.J45*Fle:&HE%D6j>hTTDdbRf&CKP0GDTG_s/:YmV+7ouPDr9<;[]wK>Lt0k]jπU"=U=\U2UZsQ^FCYdtrq8YGY:#nJV-E%sxMiiX#OI]hO-WZ'G:r(JsrRM]/$D](b%πU",]PY4MaBD(3v7+2DO4j#b1Q[FX)PJ]=eB2)Xt\C/guee7'Su?2Ne)U]k5Q9PwkTπU"+UFaeJmV4Q/R,6Wr5GYcF0O'rh9<9:%V;'=KALU9EEKT>.aq[7g$6>1l)X2ZrtuπU"3qwdhY4wAavF-^GC$.1yn8&$xU(T_738D(QQs)_k:m:)(*7f55%tVPtL>RY^HTkπU"[8=R9a84<L>%B6jP>b=L](O6HKN-[Dy6+s76w?6N$A<;G055Vb-M^d7C$UY8.DRπU"/w:U37cn2pJQ:ib#<jcTe#kqe,nSD2s<o[92>K:OT$jn<=dXRr)_.:CUuZFI#auπU"pmFIm88B,DFJdx1s2G:x[XobP+e0#R:ZQt'aGq0mDe0\2;xoi#4Mf=TA2K6(NlLπU"zm]t#0XCD\foXjtaA$r&(5r-S9W:FNFnV0*o5YGRvkgw[$=_ac'-.q6GjvTj$aYπU"L]\hqFu.V,,RB$EMND]C=^XSL:'>QR.R)OB#DOL6-o6vmPMBnR#,.0TP&mV,oO;πU"rVi1&4iaP^Av\hRO1CTt[^igjHD%YB<;i'lC;/gEjJbH\R'e)Dp.NTeo&sF/WKwπU";j:.TXU0NK*9lJ.+i8AKebG^eu(Gf5cA<:3^^IvA$0#G7hWIcm/bMMh<g5LMGuLπU"NHGY+F(;S>k;X>/;5prtH,L)_n=ri4DP_m;o$>fneGfw[Zqc\EGQ)FAS)g&I8NLπU"[uly<oH&wqxKHwoh%WR+Teh+4&Y1wpp7uTIUDRiHd%e]=G'dU3-.g)8d&%bG2+MπU"XVWy9R*Kp.sdEj%=IO,T\s0oo1g\cCI5F**?Pt34>uU^?<o*7Oj.$[EsUTMb-NUπU"--N?R:wup-otlbvLPd]N0]lZd5pr^K1(wg\\T6f_F/vK.5du7,hR1Y[XjS.;?:WπU"ISv_wOW]4OJH(]LC/$AK>\0Z]/.Gq$'\z/0\&=TYU7md3K_vE7J<+JrnSDmM/wCπU"T]*i]I/se2ApO%b]CNHBAwLfJJ:7=3kX./GTg]Q(E+M4dG1(7P,z:=KP:oYDtroπU"05'ZWv6X702;(BAh($fMz2[%2V$bF%2L\4q05rp5(pZZeCpx[eDm2vm]&Nc;2gcπU"%7V:1.Y(oG.'AzTx7K'-OKhg_&MUh1CLsOBi1MrYX5/tN(emLErpa?'&rg;0p-oπU"e5*CZCORY\EJ(Wp%7NDx8Cj%CTicB.5s/Z\-E2;T>L/RuQ2<6\q%^'7zs#?j_7kπU"P-K?w*AYzk]LO(j*ez*kFbt;J\PJ+X?+_pbMtfKaO0'GNP061+*HZxijBg;]I#VπU"sl(A^%2FYoE'GY#:2A&lU[9%Q7OgOIDX)mB'V=Jn[qYUS\FR_nk_:g?.DTrmYe$πU"Wo;$OUuR^[ory<+0h5s(Ct&+]iFzh)WI3mtVgM_rjudBI\FBP(Zt300D<FTHXc^πU"qRRqY^G3q#tW8BPof58\=d55muay<eOr8Q0l2H8XeD<\w0urN3%1P+t;qtC)dZ0πU"c]/a.=_k/B1'V:HtLQn\W-2L:j8$);TI8%nC/obu(^&]&A3V,w7.47?V+/T/=O;πU"uugL>uBfb^rx>hsGmTYQli46u%dut$k2R##DOsYA-V0Y4D8l>&/la2##&8>x#eAπU"LNtLRVTZ46\_muPnPfmF]Yloo]^>Mh0D[\7Cl:r?SYuD>P_Vw5nP6EWRG50Y,PJπU"S>x<;/uI,Ob*?A\RXn5-\Iq;jaJnBtIido4[RV29<xOa>x+-F^oc_2;z%?_OrOwπU"TdM]iP^5N/(ttv>>.keYmTP6L-N-f$bLAx3C(drCPp^%Ba/$[Pn,5r$k60=vaPxπU"dqeJbV^&*&aKH'+:j;)z=iH\Eo(qP->j<4577pSUM-\Ws1:?A:)T?bd^;e*aYbGπU"Qogfn,APZ^nOW,?6E]C6.8eTS-YhKuP9HI+h:]t_?INef&GCDNIGA;'d=(V+uSLπU"8/?X)mx#^,n5hLn%D)vtGwKQfZ+]tp.h(_]_*/UWTbHV[wF8ZVJ()Y=6t$%-fELπU"Uu*WG::Z2]sja*Q3>cso#sg*iaBCE,an)Dmh/&7I&*uy+TXJ-j]]qxup86mu8*0πU"xV4H+'9[?sw*LXIo'9K/7/>63)$aTy;iF(/mSTXOD9BT-z+FCx#7Uva=/Y)<$j;πU"ce<(#rd]<1[04US*E5p\I4_rU:tfUZ#pQ-Te;Ol4f7(=n863(Y3CDHv>h5BM>W0πU"d0q^>k2Wt#Q0Ccz1wcVm_&K2w(+N+:)qO7xX]Q=.aTnT^'O:0DQ%&KAt:u#MsRAπU"*rYy':T:=kOBI9Dl*-MC<M$(?Uqf#u7;4]4XgW,jW#XZ;B\3daRxDmi%ZP*9O,OπU"][NW1jBNaRe]RNdV1b$r:cA\nm2b^jjepI+n7-G#n*Yc;tJK,e?_q:KZ*j=]c5$πU"?/$GEYMQ$&?TEF\V;1Oe%HweMWrLu;Wu4Ak_#juY^tGnT#5s-UW*vX%9tf<L\Q3πU"r[y<]/[6#lZuY+aYbU0NVOi>%d-i;i2'x8?4.Z]iWeTURYkP#csEgY]HGQtnXVuπU"gWNLT0wAY]?T]LA$EX;BO8'R)F,GaQ1,S3)sjR%I(w;E]-D?+F/%([iluQoJqQAπU"N]Ujh:hT2*e2Az+L&[?ux/TxuX7s)'.$X8f1QZo?,U=7Jl+).nPN>L;G.g%mp?]πU"aO%qF1(^/28NFL3WVT%[wNLtPGF3V=h86DWZo\>60gn\/eD#Y?(K#zr.P%=h[\,πU"3k]\r3)xA_h:HYS>EYwXm[ULBkD)JudrgIY,S\h#:j3cJVl^=OtN(DeBNt4RhK.πU"lV>VEjVSixE5lgwOAZGiOx<7]0cAX4lMEc$ghf$Zh/j-.DRQ%MAC8)nAea9JR:>πU"q#*e)qgGFkRi^Ug<q=+djKW$,Y1[vy2kgGya\fvPWZEish*Y-o+Mk6_BqjQDuXnπU"NDRl$g$9i*wxl<17xE<m&fGILn89i<p<4hRP=2>xV'.A\?DJ=\D9&-$80(rFF;,πU"io60Of8/mh?6g-E;ntnhehTCcU$9-gZ7_s60rG3Fz_*sY:(#-n50jq$hZwZ+w^wπU"zRiQ1*$aL)-Y;sCT?,BmuFA6nY^WL]2cKNYYbloG&>Y-5tm&fp_mBcZtqqKDJ50πU"2\LMqUjZo,<nr.7I;\Q8HD(\krJu#5ie=lVFZ0Vtf(*dW%[k/$B)P:Y.dtW'7R$πU"ePvzEBPg6=n2Dk.5A$N#:*6?^_ez>N]76-p,('3$n*2cao>o)iHN'7QM(::-F#<πU"/L-?O;w5j,_3R^H^M+aX+Ie.d[HkTixMF1Tw_Y_&8qO:40z=6o[H=M$?^Ts;V_EπU"DXB;Pnd/9$vdFjOsF8r6u;$l(w<'ziNNQMjy'.ZRxo7;3)gTl]\?^v<;\3[&<[pπU";FpT^OK:o?*e%$L'GiWECFquChKcvgeK9k^(OlDJK4I\b3?28r7t.6S1T5<;;ndπU"fOi7*SaU6(:#-qy10bDL)ahdF13'%%f]%Wo:N%NGZKz;Vz&0C1%qrVAO6LsbxnoπU"E?iHM%,up&%'9%9%%%%-+%&uVaD[bv+#Qe%%%ed&%%,%%%%%%%%%&%E%%%%%%%%πU"%w%ulSg%fxup%*+%%%%%&%%&%Z%7%%ve%%%%%πEND SUBπV2πCLOSE:IF S=126AND B&=Z&THEN?" :) Ok!"ELSE?" :( Bad!πSUB U(A$):FOR A=1TO LEN(A$):C=ASC(MID$(A$,A))-37:IF C<0THEN C=91+C*32πIF K<4THEN K=C+243ELSE?#1,CHR$(C+(K MOD 3)*86);:K=K\3:B&=B&+1πS=(S+C)AND 255:NEXT:LOCATE,1:?STRING$(B&*50\Z&,219);:END SUBπ'>>> Page 1 of RPG.ZIP ends here. Last page. TCHK:126πUnknown Author(s)              HANGMAN GAME                   FidoNet QUIK_BAS Echo          10/16/95 (00:00)       QB, QBasic, PDS        344  8561     HANGMAN.BAS DEFINT A-ZππDECLARE FUNCTION GetKey% ()πDECLARE FUNCTION Enput$ (FieldLength)πDECLARE SUB XLocate (Column)π    π  π   CONST Esc = 27, Enter = 13, BackSpace = 8π   CONST NumWords = 18ππ   SCREEN 0π   WIDTH 80π   COLOR 13π   CLSπ   LOCATE , , 0π  π   RANDOMIZE TIMERππ    PRINT "This is a game of hangman.  You may play aginst the computer or another person."π    PRINT "      You will get a body part added to the man if you get a letter wrong."π    PRINT "           If you get the letter correct you will get another guess."π    PRINT "                 You will have the possibility of six errors."π    PRINT "           You must get the word correct before your man gets hanged."π    PRINTπ    PRINT "   BEWARE:  There maybe hyphens, periods, numbers, and you must guess spaces. "π    PRINT "                               Good luck!"π    LOCATE 23π    PRINT "                        Press a key to continue..."π   π    KeyCode = GetKey%π    πTop:π    SCREEN 0π    CLSπ    COLOR 9π    LOCATE 9ππ    PRINT TAB(20); "1) YO! G U WON'T PLAY DIS 1!!!!"π    PRINTπ    COLOR 10π    PRINT TAB(20); "2) HA!HA!  PLAY DIS MODE!!! HA!HA!"π    PRINTπ    COLOR 15π    PRINT TAB(20); "3) C'YA! OUTTY 5000 G!!"π    PRINTπ    COLOR 4π    PRINT TAB(20); "   WHICH 1 U BE WANNIN!!"π230π    KeyCode = GetKey%π    π    SELECT CASE KeyCodeπ        CASE 49     '1π            'π            ' **** WORD INPUT BY COMPUTER ****π            'π            RESTORE WordList:π            FOR Temp = 0 TO INT(RND * NumWords)π                READ Word$π            NEXT Tempπ            Word$ = UCASE$(Word$)ππ        CASE 50     '2π            'π            ' **** WORD ENTERED BY PLAYER ONE ****π            'π          π            PRINT "TYPE IN A WORD, AND THE PRESS THE ENTER KEY."π          π            Word$ = UCASE$(Enput$(50))π        CASE 51     '3π            GOSUB 970π        CASE Esc    'ESCπ            ENDπ        CASE ELSEπ            GOTO 230π    END SELECTπ    'GOTO 180ππ490π    'π    ' **** GUESS ROUTINE ****π    'π    SCREEN 2π    CLS : LOCATE 6, 10π    GOSUB 1070π    Mistakes = 0: WordLen = LEN(Word$)π    PRINT "THA WORD HAZ"; WordLen; "LETTERS"π    LOCATE 10, 10π    S = 5π    Guess$ = STRING$(WordLen, 221)π    PRINT Guess$π   π    DOπ        LOCATE 18, 10: PRINT "U HAVE "; Mistakes; " MIZTAKEZ!"π        LOCATE 19, 10: PRINT "GUEZZ DA LETTER:  ";π        Letter$ = UCASE$(Enput$(1))π       π        IF KeyCode = Esc THENπ            GOTO Top:π        END IFπ       π        LOCATE 21, 5: PRINT "U HAVE PICKED THEZE LETTERS...."π        S = S + 2π        LOCATE 23, Sπ        PRINT Letter$ππ        FOR J = 1 TO WordLenπ            IF MID$(Word$, J, 1) = Letter$ THENπ                GG = 1π                MID$(Guess$, J, 1) = Letter$π            END IFπ        NEXT Jπ        LOCATE 10, 10: PRINT Guess$π       π        IF GG <> 1 THENπ            Mistakes = Mistakes + 1π            ON Mistakes GOSUB 1190, 1280, 1320, 1400, 1480π        ELSEπ            GG = 0π            IF Guess$ = Word$ THEN EXIT DOπ        END IFπ        π    LOOP WHILE Mistakes < 6π   π    LOCATE 18, 10: PRINT "U HAVE "; Mistakes; " MIZTAKEZ!"π    GOSUB 1190π    GOSUB 1280π    GOSUB 1320π    GOSUB 1400π    GOSUB 1480π    GOSUB 1520ππ    LOCATE 14, 10π    IF Guess$ = Word$ THENπ        PRINT " ' B O U T  T I M E ! !"π        GOSUB 1590π    ELSEπ        PRINT "HA HA ! !... THA WORD WUZ "; Word$π        GOSUB 1560π    END IFπ   π    GOTO Top:ππ970π    'π    ' **** PROGRAM EXIT ROUTINE ****π    'π    π    SCREEN 0π    ENDππ1070π     ' **** GALLOWS ****π      LINE (260, 170)-(350, 199), 1, BFπ      LINE (600, 0)-(590, 199), 1, BFπ      LINE (500, 170)-(600, 199), 1, BFπ      LINE (355, 170)-(495, 170), 1, BFπ      LINE (422, 0)-(600, 3), 1, BFπ      LINE (515, 0)-(600, 43)π      LINE (500, 0)-(600, 50)π      LINE (422, 0)-(426, 50), 1, BFπ      CIRCLE (424, 64), 10, 1, , , .9π      LINE (420, 50)-(428, 55), 1, BFπ      RETURNππ1190π     ' **** HEAD ****π      CIRCLE (424, 64), 10, 0, , , .9       'Erase nooseπ      CIRCLE (424, 50), 30, 1π      CIRCLE (424, 50), 28, 0π      PAINT (424, 50), 0                    'Erase ropeπ      CIRCLE (415, 47), 2, 1π      CIRCLE (433, 47), 2, 1π      CIRCLE (424, 56), 9, 1, , , .2π      CIRCLE (424, 50), 1, 1π      RETURNπ   π1280π     ' **** BODY ****π      LINE (421, 64)-(427, 70), 1, BFπ      CIRCLE (424, 92), 25, 1, , , .9π      RETURNππ1320π     ' **** ARM 1 ****π      LINE (401, 83)-(350, 95)π      LINE (409, 73)-(350, 95)π      LINE (350, 95)-(340, 93)π      LINE (350, 95)-(338, 96)π      LINE (350, 95)-(336, 100)π      LINE (350, 95)-(348, 103)π      RETURNππ1400π     ' **** ARM 2 ****π      LINE (448, 83)-(500, 95)π      LINE (432, 70)-(500, 95)π      LINE (500, 95)-(515, 90)π      LINE (500, 95)-(518, 95)π      LINE (500, 95)-(513, 99)π      LINE (500, 95)-(510, 102)π      RETURNππ1480π     ' **** LEG 1 ****π      LINE (417, 115)-(410, 163)π      CIRCLE (402, 165), 10, 1, , , .3π      RETURNπ    π1520π     ' **** LEG 2 ****π      LINE (433, 115)-(440, 163)π      CIRCLE (446, 165), 10, 1, , , .3π      RETURNππ1560π     ' **** LOSE ****π      'CIRCLE (415, 47), 2, 0π      'CIRCLE (433, 47), 2, 0π      'PSET (415, 47)π      'PSET (433, 47)π     π      LINE (355, 170)-(495, 170), 0, BF     'Erase floorboardπ      KeyCode = GetKey%π      RETURNππ1590π     ' **** WIN ****π      CIRCLE (424, 64), 10, 0, , , .9π      LINE (420, 50)-(428, 55), 0, BFπ      LINE (422, 0)-(426, 50), 0, BFπ      CIRCLE (424, 50), 30, 1π      CIRCLE (424, 50), 28, 1π      PAINT (424, 50), 0π      CIRCLE (415, 47), 2, 1π      CIRCLE (433, 47), 2, 1π      CIRCLE (424, 56), 9, 1, , , .2π      CIRCLE (424, 50), 1, 1π     π      KeyCode = GetKey%ππ      RETURNπππWordList:ππDATA "JUJU BEE"πDATA "R.T."πDATA "NICE BUTT"πDATA "B.B."πDATA "CHAD BECK"π  πDATA "KIETHERS"πDATA "PARIS"πDATA "PRINCE"πDATA "9-MILLIMETER"πDATA "TECH-9"ππDATA "SYSTEM"πDATA "ICE-T"πDATA "BUSH KILLA"πDATA "GUERRILLAS IN THE MIST"πDATA "DEATHPOOL"ππDATA "MARK SALASBALLS"πDATA "LIVIN' IN THA SESTPOOL"πDATA "I HATE KRISTA REALLY WITH A PASSION!!!!!!!"ππFUNCTION Enput$ (FieldLength) STATICπ    SHARED KeyCode, KeyStroke$π  π    'Define internal defaultsπ    ReturnVar$ = ""     'Used to hold outputπ    Col = POS(0)π    CharsCollected = 0π    EmptySpaceChar$ = "▌"π   π    ' Supply usable keysπ    AllowCharsMask$ = CHR$(34) + " !#$%&'()*+,-./0123456789:;=?@ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz[\]_"π  π  π    ' begin main loopπ    DOπ        IF CharsCollected THENπ            'Column = Col + CharsCollectedπ            CALL XLocate(Col + CharsCollected)π        ELSEπ            CALL XLocate(Col)           'Onπ            PRINT STRING$(FieldLength, EmptySpaceChar$);π            CALL XLocate(Col)           'Onπ        END IFπ    π        KeyCode = GetKey%π       π        SELECT CASE KeyCodeπ            CASE Esc            'Abort programπ                EXIT DOπ            CASE BackSpace      'Back upπ                IF CharsCollected THENπ                    CharsCollected = CharsCollected - 1π                    'Column = Col + CharsCollectedπ                    CALL XLocate(Col + CharsCollected)π                    PRINT EmptySpaceChar$;π                    ReturnVar$ = LEFT$(ReturnVar$, CharsCollected)π                END IFπ            CASE Enter          'Acceptπ                EXIT DOπ            CASE 1 TO 255       'Normal keyπ                KeyStroke$ = CHR$(KeyCode)π                IF INSTR(AllowCharsMask$, KeyStroke$) THEN  'see if it's printableπ                    IF CharsCollected < FieldLength THENπ                        ReturnVar$ = ReturnVar$ + KeyStroke$π                        CharsCollected = CharsCollected + 1π                        PRINT KeyStroke$;π                    END IFπ                END IFπ        END SELECTπ    LOOPπ    Enput$ = ReturnVar$π    PRINTπ  πEND FUNCTIONππFUNCTION GetKey% STATICπ   π    DOπ        Ky$ = INKEY$π        KeyCode = 0π        SELECT CASE LEN(Ky$)π            CASE 1π                KeyCode = ASC(Ky$)π            CASE <> 0π                KeyCode = -ASC(RIGHT$(Ky$, 1))π        END SELECTπ    LOOP UNTIL KeyCodeππ    GetKey% = KeyCodeππEND FUNCTIONππSUB XLocate (Column) STATICπ    LOCATE , Column, 1πEND SUBππDouglas Hergert                GAME OF 21 (BLACKJACK)         GAME,21,BLACKJACK              Unknown Date           QB, QBasic, PDS        514  17614    BJACK.BAS   DECLARE SUB BubbleSort (array%(), number%)πDECLARE SUB Shuffle (shuffledArray%())πDECLARE SUB DisplayCard (verticalPos%, horizontalPos%, card%, show%)πDECLARE SUB CountHand (hand%(), number%, total%)πDECLARE SUB Winner ()πDECLARE SUB DealerPlay ()πDECLARE SUB Pause ()πDECLARE SUB PlayerPlay (over21%)πDECLARE SUB MovePointer ()πDECLARE SUB GetBet (quit%)πDECLARE SUB StartGame (win%)πDECLARE SUB InitializeDeck ()ππ'   Filename: BJACK.BASπ'π'   Author: Douglas Hergertπ'π'   For: Qbasic 1.x, QuickBASIC 2.x - 4.5π'π'   Plays the game of 21 (or Blackjack). The computer is alwaysπ'       the dealer, and the person at the keyboard is the player.π'       No "splitting" of pairs is allowed, nor is "doubling down" ofπ'       bets allowed. The player begins with $250, and may place betsπ'       that range from $10 to $100.ππ'---------------------| Global Variable Declarations |---------------------ππ        OPTION BASE 1π        DIM rank$(13), deck%(52), playerHand%(11), dealerHand%(11)ππ        COMMON SHARED rank$(), deck%(), playerHand%(), dealerHand%(), nextCard%, currentHoldings%, betAmount%, playerCards%, dealerCards%, true%, false%ππ'   ---- Set the player's initial gambling sum to $250.π    currentHoldings% = 250ππ'   ---- Initialize Boolean variables true% and false%.π    true% = -1π    false% = 0ππ'----------------------------| Function Area |-----------------------------ππ'   The Upper$ function converts alphabetic characters in a stringπ'       value into uppercase letters.ππDEF FNUpper$ (textVal$)π    STATIC i%, number%, character$ππ'   ---- Find the length of the string value received.π    number% = LEN(textVal$)ππ'   ---- Examine each character in the string, and convert as necessary.π    FOR i% = 1 TO number%π        character$ = MID$(textVal$, i%, 1)π        IF (character$ >= "a" AND character$ <= "z") THENπ            MID$(textVal$, i%) = CHR$(ASC(character$) - 32)π        END IFπ    NEXT i%π    FNUpper$ = textVal$πEND DEFππ'   The TransCard$ function translates a number from 1 to 52 into aπ'       two-character string representing the suit and rank of theπ'       corresponding card.ππDEF FNTransCard$ (cardNumber%)π    suit$ = CHR$(((cardNumber% - 1) \ 13) + 3)π    rnk$ = rank$(((cardNumber% - 1) MOD 13) + 1)π    FNTransCard$ = suit$ + rnk$πEND DEFππ'   The HitOrStay function asks the player if he or she wants to "hit"π'       (take another card), or "stay" (play with the current hand).π'       HitOrStay returns a value of true if the player wants to stay.ππDEF FNHitOrStayπ    LOCATE playerCards% + 12, 5π    answer$ = ""π    PRINT "Your hand: Hit or Stay? ";π    WHILE (answer$ = "") OR (INSTR("HS", answer$) = 0)π        LOCATE , , 1π        answer$ = INKEY$π        answer$ = FNUpper$(answer$)π    WENDπ    LOCATE playerCards% + 12, 5: PRINT SPACE$(25);π    FNHitOrStay = (answer$ = "S")πEND DEFππ'-------------------------| Main Program Area |----------------------------π   π    CLSπ    LOCATE , , 1ππ'   ---- Initialize the deck, and shuffle it.π    CALL InitializeDeckπ    nextCard% = 1π    CALL Shuffle(deck%())ππ'   ---- The play:  For each round, get a bet, deal two cards each to theπ'        player and the dealer, and draw more cards if appropriate.π'        Declare the result of the round.ππ    gameOver% = false%π    WHILE NOT gameOver%π        CALL GetBet(gameOver%)ππ        IF NOT gameOver% THENπ            CALL StartGame(roundOver%)π            IF NOT roundOver% THENπ                CALL PlayerPlay(busted%)π                IF NOT busted% THENπ                    CALL DealerPlayπ                END IFπ            END IFπ            CALL Winnerπ        END IFπ    WENDππ    ENDππ'----------------------------| Subprogram Area |---------------------------ππDATA 2,3,4,5,6,7,8,9,T,J,Q,K,Aππ'   The BubbleSort subprogram is a bubble sort routine.  It is used toπ'       rearrange the cards in a hand before the hand is diplayed on theπ'       screen.  Since a hand seldom has more than five or six cards, aπ'       bubble sort is just as efficient as any of the more sophisticatedπ'       sorting routines.πSUB BubbleSort (array%(), number%) STATICπ    FOR i% = 1 TO (number% - 1)π        FOR j% = 1 TO (number% - 1)π            IF (array%(i%) > array%(j%)) THEN SWAP array%(i%), array%(j%)π        NEXT j%π    NEXT i%πEND SUBππ'   The CountHand subprogram counts the value of a hand, and returns theπ'       value of the count in the total% parameter.  The other parametersπ'       are hand%, an array of card numbers, and number%, the numberπ'       of cards in the hand.πSUB CountHand (hand%(), number%, total%) STATICπ    total% = 0π    aces% = 0ππ'   ---- Tens, Jacks, Queens, and Kings are worth ten. The ace is worthπ'        eleven unless the player's hand is over 21.  Other cards areπ'        worth their face value.π    FOR i% = 1 TO number%π        cardRank$ = RIGHT$(FNTransCard$(hand%(i%)), 1)π        IF (INSTR("TJQK", cardRank$) <> 0) THENπ            cardValue% = 10π        ELSEIF (cardRank$ = "A") THENπ            cardValue% = 11π            aces% = aces% + 1π        ELSEπ            cardValue% = VAL(cardRank$)π        END IFπ        total% = total% + cardValue%π    NEXT i%ππ'   ---- If total% is over 21, and if the hand contains aces, count oneπ'        or more aces as 1 rather than 11.π    WHILE (total% > 21) AND (aces% > 0)π        total% = total% - 10π        aces% = aces% - 1π    WENDπEND SUBππ'   The DealerPlay subprogram draws more cards for the dealer's hand untilπ'       the count is 17 or over.πSUB DealerPlay STATICπ'   ---- Begin by displaying the dealer's hidden card.π    CALL DisplayCard(2, 35, dealerHand%(1), true%)ππ'   ---- Count the hand.π    CALL CountHand(dealerHand%(), dealerCards%, dealerTotal%)ππ'   ---- The dealer must stay at 17 or greater, no matter what the player'sπ'        count is.π    WHILE dealerTotal% < 17ππ'   ---- Deal the dealer another card.π        LOCATE 11 + dealerCards%, 37: PRINT SPACE$(30)π        LOCATE 12 + dealerCards%, 37π        PRINT "Count is"; dealerTotal%; "==> Dealer hits."π        CALL Pauseπ        dealerCards% = dealerCards% + 1π        dealerHand%(dealerCards%) = deck%(nextCard%)π        CALL BubbleSort(dealerHand%(), dealerCards%)ππ'   ---- Display the dealer's cards, sorted by suit.π        FOR i% = 1 TO dealerCards%π            verticalPos% = i% + 1π            horizontalPos% = 32 + i% * 3π            CALL DisplayCard(verticalPos%, horizontalPos%, dealerHand%(i%), true%)π        NEXT i%π        CALL MovePointerπ        CALL CountHand(dealerHand%(), dealerCards%, dealerTotal%)π    WENDππ'   ---- Display the appropriate card count information.π    LOCATE 11 + dealerCards%, 37: PRINT SPACE$(30)π    LOCATE 12 + dealerCards%, 37π    IF (dealerTotal% > 21) THENπ        PRINT "Count is"; dealerTotal%; "==> Busted!" + SPACE$(8)π    ELSEπ        PRINT "Count is"; dealerTotal%; "==> Dealer stays."π    END IFπEND SUBππ'   The DisplayCard subprogram displays one card on the screen.  Theπ'       subprogram has four parameters:  verticalPos% and horizontalPos%π'       are the line and column locations of the upper-left corner of theπ'       card display; card% is the card's number (from 1 to 52); and show%π'       is a Boolean value indicating whether the card is to be displayedπ'       face up or face down.πSUB DisplayCard (verticalPos%, horizontalPos%, card%, show%) STATICπ'   ---- Begin by drawing the outline of the card.π    topEdge$ = CHR$(218) + STRING$(14, 196) + CHR$(191)π    LOCATE verticalPos%, horizontalPos%: PRINT topEdge$ππ    FOR i% = verticalPos% + 1 TO verticalPos% + 8π        LOCATE i%, horizontalPos%: PRINT CHR$(179)π    NEXT i%ππ    LOCATE verticalPos% + 9, horizontalPos%: PRINT CHR$(192) + STRING$(2, 196)ππ'   ---- If the card is face up (show% is true), display the card's suit andπ'        value.  Use the TransCard$ function to determine these from theπ'        card's number.π    IF show% THENππ'   ---- Prepare a two-character string containing symbols for the card'sπ'        suit and vlaue.π    card$ = FNTransCard$(card%)ππ'   ---- Print the suit.π        LOCATE verticalPos% + 2, horizontalPos% + 1: PRINT LEFT$(card$, 1)ππ'   ---- If the card value in the card$ string is "T", print "10";π'        otherwise print the value followed by a space.π        LOCATE verticalPos% + 1, horizontalPos% + 1π        IF RIGHT$(card$, 1) = "T" THENπ            PRINT "10"π        ELSEπ            PRINT RIGHT$(card$, 1) + " "π        END IFππ    END IFπEND SUBππ'   The GetBet subprogram announces the player's current holdings (orπ'       indebtedness), and invites the player to place a bet.πSUB GetBet (quit%) STATICπ    lowBet% = 10π    highBet% = 100π    PRINT : PRINT : PRINTπ    PRINT "     Twenty-one"π    PRINT "     =========="π    PRINTπ    PRINT "        The computer is the dealer."π    PRINT "        ";π    IF (currentHoldings% >= 0) THENπ        PRINT USING "You currently have: $$#,###"; currentHoldings%π    ELSEπ        PRINT USING "You owe the house: $$#,###"; ABS(currentHoldings%)π        PRINT "        (The house extends credit.)"π    END IFππ        PRINTπ        PRINT "     Place your bet."π        PRINT "     ---------------"π        PRINT "        The house betting limits are:"π        PRINT USING "           ->  minimum bet -- $$###"; lowBet%π        PRINT USING "           ->  maximum bet -- $$###"; highBet%π        PRINT "        (Press <Enter> for maximum bet.)"π        PRINT "        (Press <Q> to Quit.)"π        PRINTππ'   ---- Read the bet amount as a string value, betString$.  If betString$π'        is empty, assume that the player wants to bet the maximum amount.π'        If betString$ is "Q", Quit the program.π        ok% = false%π        WHILE NOT ok%π            PRINT "              ";π            INPUT "==> ", betString$π            IF betString$ = "" THENπ                betAmount% = highBet%π                ok% = true%π                quit% = false%π            ELSEIF (betString$ = "Q") OR (betString$ = "q") THENπ                ok% = true%π                quit% = true%π            ELSEπ                betAmount% = VAL(betString$)π                ok% = (betAmount% >= lowBet%) AND (betAmount% <= highBet%)π                quit% = false%π            END IFπ        WENDπ        CLSπEND SUBππ'   The InitializeDeck subprogram initializes the rank$ and deck% arrays.πSUB InitializeDeck STATICπ    FOR i% = 1 TO 13π        READ rank$(i%)π    NEXT i%ππ    FOR i% = 1 TO 52π        deck%(i%) = i%π    NEXT i%πEND SUBππ'   The MovePointer subprogram increments the nextCard% variable.  Whenπ'       nextCard% goes past 52, this routine shuffles all the cards thatπ'       aren't currently on the table.πSUB MovePointer STATICπ    nextCard% = nextCard% + 1ππ    IF (nextCard% > 52) THENπ        tableCards% = playerCards% + dealerCards%π        usedCards% = 52 - tableCards%π        LOCATE 25, 25: PRINT "Reshuffling"; usedCards%; "cards...";ππ'   ---- The tempDeck% array will contain all those cards that are notπ'        in a current hand.π        REDIM tempDeck%(usedCards%)ππ        FOR i% = 1 TO usedCards%π            tempDeck%(i%) = deck%(i%)π        NEXT i%ππ'   ---- Shuffle the tempDeck% array.π        CALL Shuffle(tempDeck%())ππ'   ---- For the next shuffle, keep a record of the cards that are on theπ'        table.  (In effect, put these cards on the bottom of the deck.)π        FOR i% = 1 TO usedCards%π            deck%(tableCards% + i%) = tempDeck%(i%)π        NEXT i%ππ'   ---- The nextCard% variable should point to the top of the newlyπ'        shuffled cards.π        nextCard% = tableCards% + 1π        CALL Pauseπ        LOCATE 25, 25: PRINT SPACE$(54);π    END IFπEND SUBππ'   The Pause subprogram suspends the program until the player is ready toπ'       continue. Pause places a message in the lower-right corner of theπ'       screen, and waits for the player to press the Enter key (any keyπ'       will work).πSUB Pause STATICπ    LOCATE 25, 50: PRINT "Press <Enter> to continue.";π    character$ = ""π    WHILE character$ = ""π        character$ = INKEY$π    WENDπEND SUBππ'   The PlayerPlay subprogram gives the player a chance to take more cards.π'       If the player's hand goes over 21, PlayerPlay returns a value ofπ'       true in the variable over21%.πSUB PlayerPlay (over21%) STATICπ    over21% = false%π    done% = false%ππ'   ---- Continue until the player is done or the hand goes over 21.π    WHILE NOT (over21% OR done%)π        done% = FNHitOrStayπ        IF NOT done% THENππ'   ---- Deal the player another card.π            playerCards% = playerCards% + 1π            playerHand%(playerCards%) = deck%(nextCard%)ππ'   ---- Redisplay the hand with the new card (sort cards by suit).π            CALL BubbleSort(playerHand%(), playerCards%)π            FOR i% = 1 TO playerCards%π                CALL DisplayCard(i% + 1, i% * 3, playerHand%(i%), true%)π            NEXT i%π            CALL MovePointerππ'   ---- Analyze the new hand count.π            CALL CountHand(playerHand%(), playerCards%, playerTotal%)π            IF (playerTotal% > 21) THENπ                over21% = true%π                LOCATE playerCards% + 12, 5π                PRINT "Count is"; playerTotal%; "==> Busted!"π                BEEPπ            ELSEIF (playerTotal% = 21) THENπ                done% = true%π            END IFπ        ELSEπ            CALL CountHand(playerHand%(), playerCards%, playerTotal%)π        END IFπ    WENDππ    IF done% THENπ        LOCATE playerCards% + 12, 5π        PRINT "Count is"; playerTotal%π    END IFπEND SUBππSUB Shuffle (shuffledArray%()) STATICπ'   ---- Use the current time as the seed for RANDOMIZE, QuickBASIC'sπ'        built-in random-number generator.π    RANDOMIZE (TIMER)ππ'   ---- Find the length of the array to be shuffled.π    length% = UBOUND(shuffledArray%)ππ'   ---- Swap each element of the array with a randomly selected element.π    FOR card% = 1 TO length%π        randomCard% = INT(RND * length%) + 1π        SWAP shuffledArray%(card%), shuffledArray%(randomCard%)π    NEXT card%πEND SUBππ'   The StartGame subprogram deals the first two cards to the player andπ'       the dealer, and determines if anyone has 21 at the outset.  If so,π'       StartGame sends a Boolean value of true back to the main programπ'       in the win% variable.πSUB StartGame (win%) STATICπ    playerCards% = 0: dealerCards% = 0π    FOR i% = 1 TO 2π        playerHand%(i%) = deck%(nextCard%)π        CALL DisplayCard(i% + 1, i% * 3, playerHand%(i%), true%)π        playerCards% = playerCards% + 1π        CALL MovePointerππ        dealerHand%(i%) = deck%(nextCard%)π        CALL DisplayCard(i% + 1, 32 + i% * 3, dealerHand%(i%), 1 - i%)π        dealerCards% = dealerCards% + 1π        CALL MovePointerπ    NEXT i%ππ    LOCATE 14, 5: PRINT "Your hand"π    LOCATE 14, 37: PRINT "The dealer's hand"ππ'   ---- Count the hands.π    CALL CountHand(playerHand%(), 2, playerTotal%)π    CALL CountHand(dealerHand%(), 2, dealerTotal%)ππ'   ---- Analyze the situation, and display the value of each hand ifπ'        appropriate.  (The dealer's hand will not be displayed if theπ'        player gets a 21.)π    IF (dealerTotal% = 21) OR (playerTotal% = 21) THENπ        win% = true%ππ        IF (dealerTotal% = 21) THENπ            CALL DisplayCard(2, 35, dealerHand%(1), true%)π            LOCATE 15, 40π            PRINT "Twenty-one!"π        END IFππ        LOCATE 15, 4π        IF (playerTotal% = 21) THENπ            PRINT "Twenty-one!"π        ELSEπ            PRINT "Count is: "; playerTotal%π        END IFπ    ELSEπ        win% = false%π    END IFπEND SUBππ'   The Winner subprogram announces whether the player has won or lost,π'       and adds the bet amount to---or subtracts it from---the player'sπ'       current holdings.πSUB Winner STATICπ    CALL CountHand(playerHand%(), playerCards%, playerTotal%)π    CALL CountHand(dealerHand%(), dealerCards%, dealerTotal%)ππ'   ---- If the counts of the two hands are equal, the round is a draw.π    IF (playerTotal% = dealerTotal%) THENπ        difference% = 0ππ'   ---- If the player has busted, or has a lower count than the dealer,π'        the player loses.π    ELSEIF (playerTotal% > 21) OR (playerTotal% < dealerTotal% AND dealerTotal% < 22) THENπ        difference% = -1 * betAmount%π    ELSEππ'   ---- If the player had 21 after the intial deal (of 2 cards)π'        then the player earns twice the bet.π        IF (playerTotal% = 21) AND (playerCards% = 2) THENπ            difference% = 2 * betAmount%ππ'   ---- Otherwise, the player simply earns the bet itself.π        ELSEπ            difference% = betAmount%π        END IFπ    END IFππ'   ---- Add difference% (a negative or positive amount) to the player'sπ'        current worth, currentHoldings%.π    currentHoldings% = currentHoldings% + difference%ππ'   ---- Announce the result of the round.π    LOCATE 25, 10π    IF (difference% = 0) THENπ        PRINT "A draw... ";π    ELSEIF (difference% < 0) THENπ        PRINT USING "You lose $$###."; -1 * difference%;π    ELSEπ        PRINT USING "You win $$###."; difference%;π    END IFππ    CALL Pauseπ    CLSπEND SUBππRon Williams                   SUPER STAR TREK                comp.lang.basic.misc           05-15-76 (00:00)       QB, QBasic, PDS        449  29555    STREK.BAS   'SUPER STAR TREK by RON WILLIAMS  05/15/76πDEFINT A-Z:DIM SHARED K,S,B&,Z&:V1 'Created by PostIt! 7.1πSUB V1:OPEN "O",1,"STREK.ZIP",4^6:Z&=21839:?STRING$(50,177);πU"%up()%9%%%7-%4s.bDu<8X\Zy[%%5r%%%+%%%%xy%SgfxVkLTAud/+Y;Jyk40QcπU":K2afs5OE:ZaE.uM$Da8vsRqw/d,Vv]z6lv.UBa0e_2abLsawD7:Lkr#:+YsKNHπU"3kQS2GMM;HvnwE8qDksL1,HQ3+.Nv[1EiNL14,fDJ#SINj-ELoN[8wX7[t^f'?UπU"+IVU1flpN-e2=q:#TjvNDVdnt.)NXACRgIo<kFRW.cI8pvnJ7xseZkW5BATh(SWπU"hPig,#74bpD#Tqm<aPh.1ZH[e-V5hc1.e%jA,&75F,I?Susp:GYcQ>]kTgQ?DdGπU"?x/IPtpF0v$0T/Ei$#$':i979d+ihHa\l>%2SSfjCi4j5uC[^(c8A%jNnY9<=2-πU"qFYmwHbDHtj$=42a\TVkm4lL0,8kyvVDjpWfq0R3uH3<D&?bWcu;*1.q\,Nvj*bπU"S]HhLSq;]Cz2eyll^)pVtJg.by+SEW$DP.$kLN335w)x&(W*T3P0wpu*hk<Z)S0πU"u0suEP==>wu5E[a\Y46CFnHx-FP9xaFUHc:qI-p$nilr8&jMtp4$gVzJKgtzy\wπU"ppIYygsLlW%iu96__hTb_qEE&oTpUJVB<fFdyJj4r?fh&174Up(-]l-NJN5.lI*πU"TV\Vs^FX-Ff2QydnHz0FG#.P^azL=qquL(oE^yTjkyf%^r$t=7\+$hVZ#7fV.z*πU"N21;mlpJH]cusXv7f9CzR9bz5>km3k.c#Ohx&OBDIDsS4u-r3CfwI+hc.?C3G2qπU"eg)55f#Kz8cr2XWhio16c^Dv<gAL4Wl<Azk=Nd#h:<-e>ocIzqnz5Ts4PgS%#a.πU"xuLOnnPBN.ykL7a:Ok(s)jnl$&8Qz1o6E0G:P<-x$DYqaWghbZ>T$wuOaR-m>l,πU"ai;R9Q>FaF01+0le3U/TVgW[+P=eaxuS[lYP.;^%-A3Q*kvx/:5K<+#6Ye+W9;3πU"9vA;,1VWq%N034//s=)FNN%C4G-9;zVe*Jc5n<E/\q'+R&^E+v(]T/>,7q7tT=5πU"vf+5*f#;#*cp%M>XGfYA.9h3e3fAbqa;tnP.a6DZIVaj*]/*vDLyI9)un5Lk<FJπU"0%nmTafZRa5u=K%Hdj)-rdTngEyRAYdqlv:-OVZ:GRJs3-G\1,[:am6s5CzUXW&πU"w5iDD5XttoKrGj[bg4$NTU'a3;X;r0t'q.B&%iw?iG89:n$'LNkr:O^v:EcrAs+πU"QO[m'J^?LuE;Vn%IsPn.qFr(qigjf-'>%ZD<i<tPL3+72T2zj2)09#hLh<sN'c3πU"4a_?g4E^1RqY%US)zPQ0q$Z3cj,LlV(\w:xhfohVN0dopM<mw\1)iW'#\IX).jdπU"c<I6&[37=In4aV]$Y<vNYX'eASxq-h[+]IP0Z)cW9TF=TQ\4<Iq(0J[U)[Qvf)dπU"7o8l=l<0)W74_*#-TgG46;Z5\-iUTXW_s:3QhWIa')-97G%LuIzhh]oY#5I0iGUπU"<**QnpKUyf,$PEURau/;v:pJ&0lJ-RQkd[te7o]Rw:=vo']#x%D5JF6,d9m-U/UπU"soth(yo,Du6-][l1aSAl57;6a<9g]fBiSr[5M*C4m59gcto9%Gt._*npXi43dWtπU"IXMBs-#1TBYCA6S.(4mQ2+QWh$8VFp<)9d7Dm+,x,V_(;$$:-tMA+_0mMDh^mUyπU"i[31GbP3jUKf.?i+8'/p=*3USs;aGfv<>2A$X:9'SJ:8sNhhQC7*098^RXBhi;]πU"4JH;JaI2rL6^edU'o=\aQ:l:N<%r#OIZXV)aT-M)?[XEIYOHW1ktbF8Xy_v'#hgπU"GgnsH-k?-rQ\<(V-u&Q^>>5,rM<>Zb+riV3f7p(X;jGhV't<kdI-xd.O(WiU.)OπU"Bka8/Qbe&PHbKVia#sXLb\Tm5JR-+t)*Xnw1X6aNPasYLT<RMj=yuj(^Pka%pa&πU"SIAX[Yovvw4H44mD'R75b$izTI>suJOllG*oJ3c2LjwgyE#Zu:]fR,F)29jhUM#πU"4ZEjs4Fnfsn\4fN(UrV,_6c065;/a%JRH_*Jpp9mV3\%meu;G,#fNqgO']w8&*8πU"k59X++[UaCJEAXXF?wK(JeZDbU+$0KhzBS;J+xwhhyXuLoGob;I_W029Rei(7MzπU"VqiF>h1nUAniY<.l1ANTOl*VWY^NjW1OIl%J<?luMGNdo#MwiyN#N0Mf3gwl.IdπU"DGoGPeu&nvw9/.;hF89rV(?C9XqD.?CaF\ALhUh'UW-m&vo-#*v^rZF*?JVWp.:πU"f((+FiYQ7$/0=A]^c3eA+<t5$]79EIIQm3*BsHSXjzAO_Z]]&yT'A',a(hCEc#qπU"7]pAT;FEhqop7i,[zO8T_PV4FiltsB6?BdPACY4:6dUnYI8^E-9BAbTFL*g2e3(πU"T8LF(l167$X<YW=)qCF&fMD+.G4h)RPRO%.'$Tu0CB]<jZ%r9CoV6%a.2c-L0a+πU"P:2tIuUU<BCKo*Ud[5b(]-8>NZO4ieeWXq$PE#(Ee,9>v:)1REACfR#X-;kj>CyπU"LMM[gN'[/*SU/[UwUAbuu>?oZ>Aq7s)Le,hPd&C,%l'2yh8M8TL*[B^M^BFLED*πU"9=0a'CY;Ib>=WxN%[&3f1NfbVF(:/v%BmusKsbCucOk4j2C<yfN5gNo_TGN>fLDπU"qPcXE0K92av&rN/b91unqjl6UYP4)7:?dqjRr<o<j?c(EPU.SL-ehKsmc/y^i+<πU"kPiJU4yev:z'UTp$&BV1n-2hcWS5s&ie^4e:IM;1Gt0zL]9GrU-7Bi=dX2mKS/NπU"YO*A]:qp/]s79;Cg:sf&#Cr+5p[/i8ZPYv]fV-R^Fl*IGfYT^fyl:IOAQ#VHMkMπU"WFN=ufl?pkJ6?CcP)F3CGAe_1R2ja6RBJ4E2#EJ-XJTe&C0-H%;IOG:$,-(3.XMπU"%n(vgVnP36OvY<K?J9pjF'4wHBVh_8O-*dgrsZnFGnXjWR%?m.o(>-:k.7jPqGnπU";3De7AzMW=)Ylsl=4NlPFzV?;D_0v3f<F$?6AJjMq*2oGV,fFH3wCuNH)D>'=IIπU"p+.8sL=:?f9V]U:*vq+hS2(C[r5nR=MtJB5qQo7k^35s\jSlw]DPfLFOcH^Nt]BπU"<p:,[M%Ed:j-tJ5w$17kE7(fCOiZq=wN%8D9-Tt?C=Y*ql<e.L]MgiN]3-pwECZπU"C^qL0RGE8+0OZ*54vnVJcD'51>#IYGDoQ+3(Z0$-qD3'+^3TqU_[37\b<x#9l?3πU"#Ia<4M[3OW52(erKRB>Ghy=nw15VMv9;Jsn#-\wSCgL^y6PDYeo;,ET6FJAwd,kπU"L>/gH>Wl$1HOURw/C<<e4E5ju.U/FVn#7Tou.ha[48VpHMP[$$w3JkLPGprHX7VπU"S=#hCTje9$QFVHRi/auYd,jKg+8]bsahpfXr%>>bL.df]k#2wN'zY2926[(6-#VπU"hrRd5o[8\((>xb=cO,ZDw0CCI(ikm,o-g8/sX&IpOi3Vuw%\)3($*V6X<<#o/['πU"j7R0bKifoA$9'ai≥Z=q_X.?>j/sc69_FZ2f=345TZVk1C9fug,?gP1sB#X0dπU"C8B;Y%gjO(4]tXj8m7q'5tC6',8aiy7w?AY.?.%sbc4'O,FMn),P4)NGeemc)rxπU"y&Be':wLn&0=Zk3eUnN.ht%8%sskZb(uPapqV&eT<x)v9iSlW'HJK^2\Ws/UBw3πU"->jF3(iy^m?M-[jYfJ7T:KmSPek+Eu#+RXg)D:V2i]DzR&?8pLa.Ums;QD.Gz2>πU"FFr?&&Xf[(pdcdcn=r-Pf0-,cK:Q$M_h++d(<HO;vo?t&OuAgMQG24o4Tqw3\bpπU"]]+r7\=$0ZoUC]u]kU[d=HeMpx9yMWhD4],FAS:7cq).nG7y4AE9tEbWZ<A]9CaπU"-R_uE=\3.+nQGCg)jSI_Cuf*%'S2'aTA29)$a/.h'97*GGhUiok=u=7#Mt?%#/qπU"n?'E9Va[6(ZQ\MgZea16rYe<9_gi1Oj<RKgFlMx]FX(N%5qBqIx9Ke7+Wbp=OVRπU"yiHu&&D7JP[h1Q:-3-439>-d&jduIEhV%3[TA'lW[F*/b/t,G=(IEG*;?cEHLoGπU"NR]gvF9<&K<%3,?t&?qc9\cL4#%)iT\gKp*S20s#1h''In&^\:j]qo+\U'XMKqPπU"OQ]#;mi6t($XM3#fe2E<gjBF[%G^L2Vez'*w[1ZggGK7YmlthhNprg<hNSruZF8πU"H=upn%uV_bsqOdn?Xv<O)95SmbpIV:+/qCU/lU/HHKd)_tcXv*5(m9v-&=Po?=%πU"\/\R)Z$AwdlZ2Uxobdj\w2&p-QPGwG3L5%/$#t9R'Z^uazE/b9P^$uPOYgN[3:_πU"_X77&)LiXjlAfUmHhqcp75'B90*Qlrspt/n/UlXCD1wO*&V8y<7]Q7?suuq&SkXπU"gWV0Y72,2D)P]r?K;TV=VfJu)Jc2S_7(B$SaTNHMr[(?K-uc>wS_D4XMm\]#E;jπU"r;\=0lnr?kFgrAhTp'LJ35ofn?\di.<JMIS,A5H%lq-h^;QKjRe6LcEO\F#E_ZmπU"e^t;I9BewX,^qcA<XR5z?hT,zLIhMMi-,,99R\3r^-*XvO?lNb%m>q\CNcJPoaxπU"KEiMYD<NW9L8dd)'DdjS]r7>-nZ,0)a1T-Z2Pd?Qa:2;FUusM$?5*Z$VT*;4Cn^πU"P/zi%Uo\X.ZAG*Z-V)1Gz7%lC5_/SgG4=Zp'\i%a(cI[sBHX5.P6:SJktO/Av%fπU"-1&OjAj(=tG_>4lqmfBZn:alnakQ;;Wllw0H/dgzhZYnUhT:GUFI%gBTmThToFxπU"R14m,Ba=u2cJ8r^apvalT:A,:=LuqvqAF*3YApdX5j7dAuq2)-?VCol_x5J<mWXπU"1uV2?'.lz)B#\?Whi9wk63szi&zoE/arS$I_Woj>:uwqCLxrC0?w24qPW17CF1QπU"tp88I)/fE;)I0Y'*N)GQ:)I2Iu=n\JC5DVa/pOfaUrPJJvo8g>(r,?1Hr)?PgJ/πU"\)G_06rdd<>Uhut'Xu*LE?:b'U&i-2<&?(bZY=h'iBgge&HUeFn&=rN+sar]?)%πU":2UW2'A:(tD-M0ye1<W6zc-=[YQ&b#V^m0,:WB=RhkEe[eDk'G(WMcKbCZD5qC*πU"6a3rd9P^0Vr'8/xMyclXN4j_SeC8q$#\&3FNF:clvu6Df:_cpZk.5ICT,JZek,7πU"J?DqPe,,I/+\9xPqo:jGOXjz#tBeU_0Iw0Tp7:^PE:G2K6Hdy5$U5Tk-'UGb$WXπU"PA8h,=0lm$PdCOK'k#1a]E*eP#.H1o-_Nh#/s<VYIt;G%7*D-r.-5r6,lm&>EZ:πU"T)DZMhqcjUXo^NI<z6)FgX\\3C(NTB4P?w^.I(P)E12l8-C'i#Cf:a%);^?p)/RπU"^EZA.;_9$l'CMAHgJ4mRaT%;sB\+F661vBT6FNEfIqLRNrAu5QsQkU9T=YQ$t?5πU"ml5NVFe'A[S:Z%8mNi9Qnu93bkoiWe2k31^<LaJ:SNE?qKx-8.+n9l\D0t*]$HZπU"+1?KG]kYgUe3on\Ge:1HnwA*m'rB%v.4n]rXCk.H&GC#--x,+G.lbLs%#e5ROcFπU":kPa>q^-#0p$25*#([-j5BCBSGaY13&OId;j7,O=tt:^El9M2)89gdp9vM*V]*MπU"nudj-r56wVksH#,Hv*Q::3f#ZcA<\S[IIka4FGXinuXXB>LOb4r^[ONxG+(D=C7πU"sR%m0gBHv#VhOOaIgF[EPT%Z5VNs(_t7_0x0VJ)9h:HhlH/7&o7Yf2ocFGA_yPmπU"-^TFgfHI>Z_9$YV5Rf/qbOe2odbN#%9:dnEPpGN\XF+-aqfd75cMjU9,n-$[:Z^πU"F.'Rg[?)b]B9=1,;T3'5#+6s1CF0+e&bB3,facpt0rX;/Kp,.9c3&SqN3YiN8M4πU"\>J]Ob9e/N?Adf'S'F3Qz_2,ZKMnJIjS5RT^+0$;6^TSLOArMR)DiC,cY?j&qS7πU"-)gfc%8(Z3eI(GW'?CTbr4F-_icptYPOw7<G(fM)a/ym/OF%o&2[>WT1$\_<:I9πU"pWuFl9d$xBaOMsI;H38#jTAR,L&AdS-I6tJ;mbZA84jI#z*6j/bm^nE3iD?,WMOπU"ay#I,p^6(.Iv)_.k-S9Sql5O>ReUt1*B=B8r>#\5)A4*H=\]D6u*etFZc2:teYWπU"R2/j$G91prTK=bJOgh\8>N&p),l#uEPl/dkV$C%umz7hWp,KNKqE74,q8yc>N2(πU"LMoWe9va%$Ylp1t7O0j.zo/Fd7/%&ZQ=PlAuM02^=i4A&QU.mqr,NLFyy(anEV=πU"C$j_>)Rla&+L#'VE&<uXBC&Lr8>T'/w?+Xi$:^7DC$My82*5)pP98\dV0Ta)ne<πU"LBmZFx8?uXegI?eK;'a\.q?SIpfoi:\EEM?*YDD:Y_=lgpF9om_,Z<74[IcYo\YπU"09l&n]Ed1=:n_*9R[rnBrlRkx^%QPY_bm3*kl+Gcv3d/2;q$P3Q*#h_C5C3kJW%πU"S3KgK%,,0xVOV[q,QLDU:cZ3b1SkOC2R/H'BULj5r<gmE4E*q9^?J'\ulllMIeBπU"RkSG'g?ha+LMOZ$iDI9^gprJV)6D$e\UspgT0jj'&_pR).Z-190k[,;c=N]cFFFπU"[6==$/G<cuI%URBdi,6JL1&,fXB?u*7ubA0<rEWW#/wW1Jhh;2vW5K9Pa#LTF**πU"l/2j7W_>]fY4jxbx0Ab/L;SRq.M4+$K2cG\Bs2q:.k^k)-R]SBRiYW&2%R]5uJ$πU"CZ1:SY2-q::)RjARE\=eL*-?:e3abq(9/nG/bO;W:HYCXLs5?Hbe^Eon&81aAsIπU"5gqTK]5hDr'II]ZI.#WEH*hDu3a\u$-9'Lf\?<T:2u:FGqeRq0Cp;^&dlDxJ-7=πU"O[Y?QFZNPK.i1W3+^5SZc#nCApm3AO/k.W9]gKLp(nWtBWWiw).:Be-uoe0U4^uπU"n6ei1;(fhh(;M<o3VT,_z3pW7Qz3:j(WM,r&wZN&z)etL0lG*'j1FW?UQg_2WLMπU"&G*Oo_Mf&-R,fvr5?.x;[50()yhxje'/sEi9P5_d5:UDc$Zu'$$[.uO&Mxv)I,EπU"nYmf)cl+'(CdoSR=XS4xnFvbQS.M_mfb28]d&2UnHNX/p_fbuU.LJ&5,u/1*[y6πU"bV3_7:1W>smo?)ojk;FHdz:]$D1Cw&WZa=*GoX_s]TW]x'b*En%k2z?K)BI+PiwπU"C+%1:UDa5?evuc>ZScY&\(M&E]MRh_,#%WW$><^JR1#b;m#-_4og=qu4=sIseFtπU"k:9F;]VtE3:T:YrG31g.X=Ae&%XW)VRAHPgGR#t5[Jg(%,OYA$)8L<BlLG5E4mWπU"*915>%,au2d<GGQ_4bW/W(a+W==+-:MeCMkRe/WNBD5;1Os^Le;m%<Dbi7+)m=NπU"O$hr4e[$[4hNNdE)Nwj5.CY*ao-L#3w8=N$S7n/_]oBG)<vTivfXVU3Srb<6RUkπU"6GI?NeMUGo\tLF:,WXj6Sq(^;W30l4rC<7S$XK>si[47=$=&dq&BR_QEP-R*]BgπU"wFWQRqHeV\hT65A?Pr9_W.in)WX;7jNpH[(Dq36c,s%#%^D0Y?&BrX;Hp(LK+L+πU"8W$+4\AYQ;(6okq&/2C+UkH0FHu00%#>_zi:*AU3/ELMmp(jBGFx#NE+?r0[/+gπU"<Ew_sAOgn=t3$Ab&,[83_.=$$K*GDC;C&VyOnN[C5B4Wd2W*3r<kkD_?.ax.R\cπU"Qyah1jTA\if2\PCFl18v\l_m7\QPjE1%)d9e?vf0e4Bh-#$;7G)#ZGAl3.]Psq>πU"no-2>Fp7:=D3aIo>87Z1)4Fp)q\9o=lV$&YKQzRUeZZ,Lcu:eVJyfbQB;,j4/W7πU"Jx.IK&]Ek(KIsE]Ie=urLL?g:53kLvu1t+dS3t-2DGiUK5(dMevnbge8=ajl7X^πU"$(R3Nkk&G)<74'R'a>t<ey/U;L;o5<i*9:7c(.k=<lw/lB#L[N-dTYe-je2G(xQπU"A9/*xz>zRAgXn)Gi6*))(D_4kJ]Z:zUp#u9'gf=85Ov?7;BHe>1B\I%7$c5'lchπU"XK7iL]c1IX;dM>K*AMi%6+skoDgUt*/LPiY9_Rk\0Tha-SnuP]ZLlZ;hak<MTqBπU"^4QS;ihG^a%YGxu&OsMbaF9fViJFCG4aJFu=7;^,,:FGLZLfEiA]ZUY^qK<)Ta<πU"(sb;uSAs/:O^gR*S0^sAUA^HVaJhW\w'Bqo-75bATiJ55r31Ps'F]lPM%\_sO='πU"'gk:Z+*;]1O3b/QBQ./_,/9o6SQTyOJlzs^Y7]gN47:R65ZXk%c8b-(3Cp2%lc?πU"c<Yr,J>o6Y>rk8,jF%_BXcw=GbI=l*h]T?6&NNG5EDPDWhCi'iOq8vUIARh)=F[πU"aV^?gdKFeub6>Q9Bsu$1uH04XIdd6mu+W(UO>5?v>+,q\m>9H(x3)^+1<jS;S01πU"MvHio:J%dR4598L45=xK)O1%2Ulq7oL#CKeRU'v1m3&O2hL4m#2wt($V6VEZLBzπU"V\l17+4CAS+FJHf4b2lK[YTRjE__#Hj*^Ah$VV+IKwpzwb3B+C,%O2oNn4\[t*)πU"&RPM021Qv7xJS+)'4Xy?.)coLw01VUfSr\*c7c*>MEt;<#-X7MzYCfnPnXsF<1<πU"KDcKe/P.6BR(2V+t]sMYPtUN1,pIY,bTSmgEn^x2YJ:b.(5N8n=\:_?4h]Z,-[7πU"$#+67Ua%/30l&O-VCut'+r'']rmW1.?av\hk*SrKpjI%'jT^PFqL5;4=(AR6d=iπU"GLdLT/WGk(Kx9(e:bOoCiO7TCtC]oOJnd#Br:OfIUVKU+LVY;IG=rbT&3M$ji18πU":Kl]YmNmSI]-a7nI3aHLM?ic'*_\z8#jL(&=Wmr%fu>7ppl:A+P2<O,5gn4-dP1πU"mv1c#8$Kr[tN09S#UlhEr9^&;1&Oz*r-s\TfpWRS1Ul+]S2EU:Xkw4U\dL186V+πU"IQd%]Z4u3J?[V9\9%)?^L;z;me3xQr%;0V3Q[,<;hf,2s=9P7E=A_TXI5kAK&:dπU"2a<P1iLJA,dFf^p=B/GTLWBlp:.G;*Aw[];:<L+2*0v>$>vtD?PJB\VH]\ouHFfπU"LKJm\o4N:VScmd'm%*;NCxZSS/2JC'.e,-PKISHutC%RE\kp$&a\5K\<FU;0\xiπU"gA^BY',R:jEIECB0/7MSK30MA<(Mf#Akd4'Tb)43mD1VLs?7dWuuC&L5s[/ZFK)πU"[7Rw&Zqj)Ah5IT$g$TA&HrCfq6+C-SCdSU:%kQ2]GxTrQ4#1#u^QB'bipAV;a?^πU"bsv^=d]Vq.?k-eV+-YDW35^:.a>rLTv9S5;E/3:wAHrosA8[I>jX)a>8%eHTcQ,πU"PCaJOzsKE3Ris>?3pEiRU?=4\i<DbPWiSPJf'RgtK_e\-:QJ0Qgo'iIKOGFM>0qπU"'njGl1Fce\BM>_'(<7$]7NY:WLo/?uus%N=,Z>17.\#o/?Ep<o>[LK[kta*i+$%πU"nc-1\(YmP.W[HJBQAjbAw.uJ^_Kc.$;eFwI%qAU)=u0RS>sdA02Y-.<JL/Fj[4NπU"-mEC.<J>$?*(lCkR\pspmY3(9G:)W-4arO=L'+Dlc>d2R'^ibP&XsAcc&k-8WZ#πU"SaD'Z'<>mPE&<B$:uR\::1KMRF/=0?MPQ9X9Z1o8<Dwxq^jXa8,[fx)Npf+dCtpπU"cQck>ce]6aPMYbm(MedtG-GifruAGBcg]1f[x)HOX#+)oeRoHK?8Sc8(nhq[j84πU"[[E\'V_eZtns+<QY\f1.sB(Q0cFT:[>YY5BB4?Kb1K;_^reBa4/4Af3Em4\9[6bπU"Y4:w+'(?0e_.7gu4O3(T8;Nl-XL)&lPuB+.#nm/.>IE3]REZ^7fYm:HCQ-)oQe]πU"6un0fJY\Y>7Z/i4ASzFrbG&cQZ?-)'Fu[Sc'&Ml3ZTvI0KGf8]f?qFEOn9LTPe7πU"VA;8h(LaL,Z[BVj6Tb\[_G&n:;6]i1_2RMIUYgm+J:TJ[1$wk7.$BS9Ao5Ks/A<πU"ivPqjZAtuDDf,<;8_/WCjQ3cS+d*o2MC'*%zbO95Ub=Kf'8lB^FWlI+atkF*eEAπU"S;#c&Z_LO(Tx6a(t\?rkolJ8oa(&[4#h8jDa.^S#E-5jH4MlP'?^8i]2F:Ga'MUπU"TB9ML;N_#\t1#?zvV0el[L;.,:Ak]Luq&/JJQCaNV5%4-e>fCk4:8pc+1;/VvpGπU":RcwUk>[A<VnwZ2]TtW3MB,U7-&xYm3z,(X?QZe/_n[=,/1#33C34x0vQi;(2YbπU"Kl:lk%'UfjaaH81Pn]?j=_WMH=?xt8'-4P4ze,xrS,\Wp3h8lk1.oF]J/^a>qm?πU"BkJA#R7qFvg*Ra#i8a=MefHPGQg>3&pu80t<CEp7q(9sBDKGsmmA<[BNb0:/JB5πU"SCS4LLzfL.9XE<.<nDGZ7yAH,YB5Je*n0bKLFQ&FfZ\FJj89&la+G$LsJ)>gHdoπU"oJ&-Js0[%F-PBV_,AQGN-+ik=wopZT-Vr&rM'_3/P$AKM$Am-Ta&%#0\L%D^MJ%πU"e>pBZgC.&7rqOddROv8]?,d#VUdZMDWv(Z8?bR*ewG(#<h/DN]eF\&GR$t(I[J&πU"[Vh.\b?3l3U;T)L$gR]p.TkzZ%9ee[EhBn14u<heVZ&A4jZc>])eD)NRJ,o4XPBπU"=a%X*^X3[2mi&D]jC^u4'e(cnYs/jAfzvcC5>3dWD=[er?-u8\i615lcwaS.e;?πU"Zt5(]gr(;aKo,X/eI#dB4-l]lIOy]5RTsR$#p(]Yp8Vu6Zf?Bn-Cq8&IFAtYthmπU"^(dg_l<;$#6yT#<M0Ev2pB=9SX\emE2pr%2:-%$hb6<,KoCJ]183#5ejJ%g_Ue'πU"S/]]IZ+/4nt#;gMTuWB9W203]ru3B<M)Yacf2QkhjHFTtp;Zo8jF,)D^Ag_\G-UπU"n=7WWN^isa0EV<(Jl(#bq=w_ezI/N<iJevsM\-P=;Jy^XKR,V3f<c'/r0xTF:-TπU"s#Kit97]<apowBO<O#0gT?:Pj__$Ha_Gt+<6u[o)]>wnta.htoQqHAKb%VBo.vmπU"qUEUP:Wo]RQWFEiaCNj_n=[t5O&/VhttGN)Nj^Gj_0v0v[q.7v<YsmGT'Dd7YyXπU"G7K8_A'XsWU/f+S<LD2+8oa=lzI_\U>%6bfS3sB9>n4,V-N::\hm.IJ,tFV&4<OπU".AdRmJ.#3f+xl=\3c8T4$a(cD<[%g7ff\wiH;y4V_ZAu4oRKWl$9,1N]$Cb];ydπU"Q0gL8.J:Qc-\=0qnbR_uL6UBihdr$v^hE9y<rGOW(h^&q0&IdOD:T-K8Zh8ID4rπU"frY%<jT]g>ZcWMCGV=0ZDXb7\A>9Gn5%r]ZKp>u8JTs$X18[JN-s6OHFtCYoVVvπU"&4d-KkSmvniVl(R/sKabXXc4jG#Q^_nCCgw6i)mmm=#:xdX/%P<JPi8u3EL%/7tπU"JwL\++_$&^X%S;q,cF8H8Nh<*f:QJl6ZjO9,E(>EgT6\Fi7^N#)t8q?\U%Od3h%πU"gwG'$M7GTLJNR[>dY(Hu+P#Al-N9TP'Tv\3\#Y[ko+0,Qno=+_G2OSpE9]f<vD8πU"TfD'PIg*o1dZxdO>&<G'FnYYi+Uv=xmg#Lc[Jk<twJUNB#JhR-yApaxPGseV9LPπU"9\]qn*JQ71wOxWd3$z\uyz=hY./t_I[.Ks.YdI8uTAUDy=1v<TA+KW%7lC(JZ+xπU".pF^20BFcp-Y/&SPz4M#O.B'B^&fQErBAZ&#%n'w=5d=&UFo5+_:[j2God$q+F=πU"nERcx+6IY5JbJafRj:J&(<.-[X[HO5'BFnV#>Q-h4FF8v>[_1kzDar6GW&wk26bπU"3ZwlgQ+cf:/G^>XiT0>PZHC4]afgQn*1Xu(xeRn\mv)tt^b.?X%VHccR]R>^<$ZπU"IXY7tc4ya[K%Vbk3cd]XV\YAKrI+sn94o54%,kQsV;^j]US_/VW7JKAE9?V\#(aπU"_;QTnN4*nCxgn=L%6NC%?T&Nxv';aU=Qk>G=,p-m_z?]HAq6(VI)r]UJLOuXp+hπU"'D?'J]%t3NNO^V+RrwlOFix/p[(Z)AUe?Bp:'BH,_j,%WAvNAf6tS<A*m^+6PQLπU"70/%43zULKkk)j4]oeGSL%c=]5(1[J.]GICKbmz6KU,SE5Mdbzqf&*7yUcF<I;>πU"T\,e>K.*bNYBv%+=UHhG%t<9Mk6^+*F;g,PgV[qbKi2&K+0+<.oPredK)Kb+NWhπU"t#T3,#AJ]yJXhP6Tm52UL#qTtW+El94V>&1YR>ggQ5s?;Xn_htSaH2->5'UL3hMπU"MP+Z=B9]0^t>MHJNy1o7.'Z?+fYz..TGm)>&CE9<b=PGP7'C:-jBFL5IxCdaI3NπU"O<#EQF*gWn]N>Gnp4e9I*\7[ha2_YL==&1.KmYW=lOs,Gd>>AK+BAk/OC/E#s*MπU"$q(dkQy(i+Eva]ruiH=ZuJ7OwUp_o,fXDXW\8FTeT//Ob>H\SrUIA.$k$<34uvSπU"Y'WjTOm&]X/pX+25A5k[8,-1%P^4-d\?9ms<OAmY?LZAe%4A0JI:dnOrgQX$t'yπU";htB.:#_+l.MX6pvcVtW6A$,D\Pk<5[Megsr]:h-%>QxniS4H#Y1k-qK05Iq8FKπU"kw7iJ^79by=e:u#;vORh2vv1e*[VbI.f0GagJ>^AJyT(u*qVS7XGOC,>**rodU&πU"2OPmuBafM))qZX_UPbaGNoQh4di,M=V+7JG,OFhe*$>b.uxhN[o57AIPX5cb97uπU"bt9XnPB:#koj^kKr,oI4+Fb+o0APQb4k7fuE]H<X6b8C.wGn1cJA2Ki>)h1BMYrπU"EJR0pIuj9h&6KKa44_':Ix6:i[<GLW(^5Rim5_;2;Ln&#&)a':EsG)Tt5$BB=iDπU"-m(H##nKH]/oDdIkV?Dd#2Dn*-ihdg)L&TnT\SFQI_4C(j3V(iG7%I$'V8IV&oFπU"GPDmR.;t*/VL)L&6TcGTSGq7Wsg0%JV-L#$[#^&OV&k5[8WuX.BaZ_gn+F]8,6TπEND SUBπSUB V2πU"MkbrdTt$*&<k..d*<_75?]6KIPP*jE8Vk%g?SQ\*<NR)/(u^3[:LV=1=4AHl:-cπU"s(rky9-s4lduM%K1g,G5:\iua;>Xp_xAm.[3<B%Aa=bkrZl.SA)oFrR^6QPCf[nπU"Y:.l7.\;GsW&SEUE'+PZr:o>R-%M')O*W[mR(+jtNCjO]qNLP.kr%l%(o>9n=CaπU"fOPIc>MgnA4O??p8>n?'n5QC5u2?];k[UjHY1P*oS%rB^SDOe,2'Fcl:j4?gVYsπU"LhgU_YgrDnaTs#\Ge9h#WG+:3g:]>pkq&n0Hva\wRVbr?oI2ab#0YF53,IB(mT3πU"uX8r9Y.rA^aaXEiB+YbbeXwOJ+Y(*oDj4FK-d83(hq.8SCKK[7Pfk<_uTxwa/$JπU"/V>lFL8i&O8b3w8+/j6FmC_5uEO4kf9oXM44$*et^=V7YiH,ITh<X(7ahs/k7;cπU"g7'4FOTor)Vx0Pcq-lgO27?u(FO2l;jSFU+nRP*GZ?*H^llC]a6)]-OLDkw:M0nπU"-cfOZ)XaW+=j^[YY-V3+SS7&544?VXil\S[]%dmiUpfF4;-Ro:'oH\#1HI1:L>fπU"NV9T?Yj)IdmZ=2Y2#-#^s*'NFia#l4nF<LG<Z7O.ccA5mTSs\Z(i-em7Ok19DiTπU"<\.u=2PnQD>/NPW4MmQ==Q+e*;X,Y#]^=$8+ug*r1/w.Kr%G;l5nV+8r)m*^j^)πU"jpKSBJ?QUPIK7g+w^A()WrONAgeBnLpY0.ro3%E=nY&xlObIq2S3i&>Fnq'Ax=$πU"d?_OAs*&Y^%;v?[=;[&mo\bTK5OtpVUzx<N%Ij%aJWeVAE:Hy(=9?BEbeLX'T[VπU"p*f*=YmN]6MCMMMc1]fL4UFBGY^V#oT_/EW$d<nG]DG2AlmIl%8Y,CGuaf<pl<7πU":tCVbifV&9TQ?N^,fz8B^Ibg3=z4SjMCuP1P+OX2$r]hNRn#u<UUge%xlH;_VG5πU"Y)Xw4mPk\Zc[2+m$tE=)XNIp'R)HCKn?y?[4T4-<*1wWsH^,:NQRU9ZkjxQcjJlπU"*r'LD+8>BV8McCDZ[*uwa+q\]0)QZwqloa=oqagR<U5*3R1VMIi#\NhIVNT&,HWπU"tj'3l*^i'D453]DZ]TWIIo_m+qLqoEEOX*LQGyR2\\\>8kwKJceqG25s=S^I8nCπU"qV3nQp]uX%5=.7'k=5KfFR^D=_a9,xwpD5M4ZiJH1P7)]^cux5VljxR7l$x/WPmπU"kN39v+u5d7%7?%8']u($XTZ,UbaNf/3v7lnWwQfEJ:1=#fTX.:n$8,^RVx,YhQ-πU"9QhEt9+Lv$&'%0wi8neqcGB]t&dMK&U*aka]AVVBC.nYx+$ZYKlt:8b2MqP#D[,πU"?Zlj%:_1Vv_K>1B2Mno3BvtFZRa,gwzEST2390i?gGjGS4Ff1';DGZ>&c5gw>n'πU"9[Gj1?t\4d7^zeIrgq'oPUw9=1nZtg-=+Wi<:JJIiJGnP]]OlPs*5apct/Z+)[PπU"M'QnSMHc9bKaPWuS4&2ZEO6,A5#;h&KMH*]%^?i^3<#(9\g0G09'065V>-u1zaKπU"l'7'VmEPFpXaod\+IlJOYUsg#qJ1EH=L:m0jIQfve\+(0DEbRvL7Z0D;dh:b3MHπU"_/)=.+\eZ+4^1*C^Jm&IE=5S=<5c>7:wg%%XQOuPHICOh=k=$^*[_5P6vpWh]FDπU"-f9oy67*$x^X%Kn-e'b3([:y)M<1Ti9IRW/U?$ewexjXNicHcYDU$<M5-iw6y\XπU"%2FiFmZRZS%h7K+rse_P4El2J6\vQ*x/oxS9VvVUc3oR5oxRc\3&WGkD7D1PgG[πU"e&=rp<?R%D\[0>zZR6t.=UJI_d&'O^;X.O6\W<U>N'#8eA[j[1<1fhBUqO;DU3iπU"VF*$gu\YEWlcgd1-ac2?em81>:jvh?Mg%_yG,T=4vi%BxI-lkeF7r8HyJuL4-<bπU"DY-aY(8X_#=.8nt+[x=hQjPyXS$HPmOU\x$MdLNm]6LQs2$^Qxur?],j;,&:?UvπU"YCe]hOd?IHX*?^S?AKO=f+/\VVyiiIVCtljZ\h[048'HTa,AEQl^\?t9&/GU.fBπU"S70Y(hRDxudVh=UQ8ftDP*vg)g8^SmPqE-+AP;K)5q1tKm1Xh\7jfQ55EtVLh\xπU"x*/k+2+f#yIJFC8bBIe>VW:+AXpVh9PYh//-<7Dt2S40%z%Cty]M5)rHTjx&#/XπU"?vOgG3p/1xT^6W_*\X3?K9a-#w'+?*Hk3*[RXCha[IetuuQ0drfTK2yI^Bo4xT-πU"gztkQR2=e%<ODtf2?9uf8OMM.M?Vh[B]I(dJC.jOU5cPx=uK(M3AH?L<HFYrjZ_πU";3NsbSTXiHN^_UdNwVUW=;CrW,EIT^r+qf3ZB9viku-)l0E-0T/sgg%(\?MeqXsπU"lMJX9V1/xag0i[Dn-M)1oy/qTq))&_)#M-'GMiNa;,fn8m;m9gRA5OVR.%xbG9_πU"gZpPYFWP6s2*C7Jx)zsl-<M+[;rFve8Yn+xPfQd=W/k\BsL8ap&[';_Z;)q:c+yπU"SDgs;Yu-^Vu5pgh94+>K+0w:PLfJjZY>&>K3,wC7ew6_wA,%J:HkEtKx=BEY+[kπU"ohGk=2B-Z7KdkB-ta++hQc>^j1g)WEVx[,[%JnepoWsUGV&#LsuRi$b6-BS5$UTπU"mhPm)KMb>,YFs3xM_D5AhKB>w^,t5wSsJIN$1.Qz9_bqHtwhK*>7OfrfvCFkipbπU"JmjxIHo7=?Z-nNe8b>n]M0BrNSbvN5840b0,:eho2\6:bPoBt6IkOnYM:Nj3Kc%πU"5<#%nsR^fSxDcQU+=L,RI9u4R6hk<N#G]?;0[jDH]'MzzbfJrVk+>5NUCV*D[4YπU";:qC/($9-4gFp]#6b7>]kTgmrz8n?KSP.kcv.x^ARxL)Wu,W>GMOOCD0.;Vw_AIπU"PNS)n-P*GV=PANfb/MfLF8AaOE(1li6rt,a>hx8(u)PtE#$5N]LO2fEu$s3*KWhπU"(O#;kq(W$4Rin/H&K7Q2aMG8*^5.9ov^^jP)kFX?9GA./G*;W:wfQ:Faou.Q*T/πU"kZ32<B7I/cQU>)7zX9oJ0E-qo>S\Ahi+>fW,q]o1)tll)S8'So<V&A=\$Va#pn8πU"1*6Wx0IcHolN0[K9OXiONX*f-8lj5q^Wk5suH/[ZE<>go0\A7N%e2J5fPXEI1:uπU"Da^<8]:Z5Q?^fP,GY&06W\tE(4Hci7V9h)oa^S8/kH3Rq+-QNaQ8fKQ4N\/t)0XπU"6469s-fo?tGA4r%FB]xQ]RC7+Fc5iZOFZ(LHNg>6j:jK.0)5*;ZqDd>Pfhz,u7(πU",^I$_[3:/>t>4#G6h0,#V+.>&5mEu)%v,Toc+#Uu:<9Lj5TpL91I%;]FE[H#^_8πU"-Iqn2iWFd%r)'8ppLXsTrGg4'LBkXEiGr>=>RaGh6V_f_z.2\aI,UMQPlp3c#nCπU"ll169c;<nYxCaEZr?o#Y+/=DRxYFP<p']mu/s&VW^eAXd2Fjf$g+nHH\FHbH2KnπU"1sF3llaIOJ'cg827vx?iVS%/=b[j%a>[sIF0n$3^%-qH-X2jXTgM_YD561(M^r$πU"f0&F,86vaVK32[SnWU20g+6sOBBe(S?OY]Pn:U_8RiOt__VSoR)mV+7C9cRR52OπU"Z+.79hR5Z\;_>EjIqd8d0Xl:RuR)^;lX2gm=1f5F3eT^1bnEXX:[Nbnx/\+QI)DπU"4oeq(:^t7jjpF7>E8<KLq(SsK$V(v.H+CmY\?_O>HdB5%YV[01T1>-r)mkpkXhuπU"w'^kFtaRMxQh;oZ?#$A?JO]YRFR9Ylr(%LTW).>)(H^o-v)x/O?%pj8x7Ram#]6πU"W*\$>P,6EJG,rBh)DpQf^LIqn9mmdg*wUP\cl>+yhYwb$5$'_w+$t*QCBNEdx4vπU"7fClV9Yan>PbhxNq^0=vQ)fGe4tg<$lsu4%SzgJ34mUw88:%2>DTfFuOb9/]eSEπU"sR;0vx,'?4qiDYM__f,0LJ(U#K#cWV+#o&.CSXt-c3gA^Kl_0=;_f?UY-&Q5fiAπU"Et9%J?Dr'a'sBuEv$b4i:agu;$KOB_xT84Xgo;JJ_+-5lZ6dv<IEq(jJAt:cPjwπU"$JoLlS_(2c8tXh)>^.]Nw8>smyOIJOq.kD2:Z)_]p'_q*=V)xus(f[4aW>N<.:\πU"OY)riOg'ngJ9kA5<'t+'mViG+e'Yt&d9.tpbnu[,N13o_YjE5kZrF>t<;FYZrV7πU"u/$,;]w?(S3c#:(6^u*#k^A\&-PGt4YL?hk*,y?8csu\h\$tyR[0g9o>9R-S>L;πU"\0mIwBZg>b(p=WSii]*(>]XxB42:.]wAqk_8$[z2c-LdOhy+V(2l);$PK\7coQ[πU"950_ZuXBZoD2\LFD[gPny<b>D-w%\S/Oiq4;_\0-L3=,FDeF'M\$HRk^;q;8+]pπU"bs,jAlDUfyu[C^B<;ZSWlcI=4q'lQkHRUkjrEl$/sW#-#/(OAfcZ$.F[pS-klg*πU"UjPY=7X.i4KNlZ[\*(gv1BT02hO/mUP';\sWJtiiqrj^.(5x.[&'B:9QFxqSQ7iπU"/TxmR#=A'INI&&2/78\n(7W<rh?/D>giKghg%;yqIXVvSQ+?zOaH'-h8nd1GU8[πU"C4PTb,O'Y73V_Q+8YVAsaTJgI%A8hlF8Vzjv#Xu-v;PoasR2,1#fp#p>B5#TXL)πU"gwe6:L/hKclkLI_7.Km%w,x7l0Ud._xO%o;OzU/H.mJ-=zuuS^oysh\lT*?_+16πU"B2DZaXDlpyeaPH_bA%&A2<=rvZ=c3;A'3j.cCa_,z1N7JhZAhF5ZaRW&9p'rT(TπU"uTrUtTKPiK-Xu]&Gvv#&DC2kPC11*guvF[Yc7HP<%VV<8N,u15r^T)dfY0i+x+CπU"Gqfvh]l%8A5G=DQ4M#^b9vFoVbQI/QT#UB2,2AT%oFb89qGM?3+X1U8:lWZ$+SsπU"zn'GN\tb2Sa2LK19.rxL-H1mZea.OdT?,$i$d[027.Ypm'U9%&k[cw\m>9'tv*fπU"KNW5O^Ot'$94*]>dk1i&FN'kLw]-WhlVW54oi4mHKl6Q80h0w4BN#-#]eN*C=gJπU"dS8A<_LC1-DV_/89f'Jek=tPu:cTvr,Ig_aVoK-w'fA5$?1g01(ou*28f[R)AP<πU"O.G7j[lj?$+*U_*Vyqg-$(\HqHD166*xKa$YEii=Lc5J+XZ^:sWhgS=UkrWT)#kπU"]Iz.))Yf;3mAKf3(b&bA2fM-C[j^9)$_rOFcn5PZa'k<UDMK)'[nsho(\9k$]anπU"k%b^oSa['=R\Msn-o>SIal9_W\q(W-P>rJy_A0\*z6-w_<Rs_o1Qd)M0m1=o^MlπU"ehefiJf&bcBaoP^N=UM.Gt,=ds3vVU'cAN]>UR#Un'GG#%pTR=B]dd9Z75Dk7q(πU"0QnSjo_WUW3O8L,41gVdKSSr\R:5dqA*\REuos;Rq1EGA&UdnJaXO=O09d;:1QlπU"4(GNI\pDFead<eG518ERvt<VR=%R<5aG*:bB?+3F_nEC-Lk*f3kq(]oM?Rf5:ZUπU"<4K$86F%av#m8;:b9k+n8>6XlrJpT#\gUkhEOmt=]fHkd]'(y,RW1864pH:)mFxπU"hM?uMOLoOaUwqN8P3uT/'%ix>/8SR?%R1K<kJtX3QbJ-0_<mJzeQV]3##aDY%$WπU"rnY707>ahpn=4):xo+IHGiOAg]f^1,0apoM6Dd%5b(<oHvt*^U'J+'n.9r=(;-iπU"1g>wov\cVYKFimXRD;%Sh20u8Ah7Zl+HQl.1*JvZLqppZMTZE<2OX\8OkzfrKY>πU"]5n4tWI6XjwlwOt#e#Z;MUdNjQ0t'.e<j)^B$gWw1VW_dI/oU)H8B*vi/L>J+C$πU"0XVA\fms^J2h5W9=KR2WfBG4_sGaYu)Ge>>OIucb<^-2:mV[=?0sam*S0g-+1o=πU"P3#[*KW$LnmpFratK?,]<F1ZU#=.Blf')%3i[1eCg]$l^-lqX2diMu[rY5%DYG0πU"cwE4be:Z,enDHv?1o[.>y5\KJpLgros,JXu\O.h<9UE=;tj\oNS,k\*=Rmg=a[=πU"^&c7Y:Lyg=+P/WjL.qpQ4Q#d83Tncq(N[oCMY>wj*^]F=rSC;/*s3pJT0i$fi81πU"p^920V.ZQoBYYNl.WR6WT*B=3OTJ-i=g*Z\:szJR[XlXWjYD2X>^8Fo=hw:hK,cπU",H=J>RO7b0XCs;T22%l>XPN2^j-(Z[M:d$1#q[ZJ1SLz;;k;SS'[>da:1p\C[CMπU"-x_G9\n'^8\QNtxExL4/YK-e-\HA#do?Wp(T^?a*,DVlVor_B7dc=8l$t%oasDrπU"Q^GS;MS=a2Rlvk'CtQoXEwbp5^P<sGrgMul3\Zd;][>ymx3=#LIFDm1pYp*$_6PπU"Ec';N*aaAjQW='$MYj#<1,a^I:#XYQm&d\/RRuT?i7nRO10oS5Vn?dLO=L8#X$uπU"lt?''v81(pRk>^mG:vjZu&l5.>NLoublXtFppb784KQs.YJ8V&zFvsMq.Sqnm8lπU"u,aDcEtMxN0sGsHJlx?Ko:xN&Wa[R5Kp1Cv'ZM(4(#E#pQ=f7Wt3OG2>,YO1ht*πU"(rZ8JgokzPn7^&r8mFqq(j'XQ#hitw%G3k8;DSfInI)Xe37Ip>a9CADkIi_9*0TπU"#tM7Ws]<J6&=fOn4*J&QoT<RuA+_nu.RN4&mImC*Qo992+.kSVQEk+%_2n=NB=&πU"4RIm:\AD6q#4*)XJ9Gy5JGgoO-Sbrep^^u3sJa4T3_JKMm*=XOwb/)N[:e/j:ZpπU"nw-t&hFo*[d$ELQ2W1B-GPc]LTvc-<rUjpYzF+FGehYl:gI'Vjm$yocsNo?QMVLπU"K_[^r%:[c96a2H1MRoacOvZkGF,ARA+Z2Z5P,Gta,.7k2tVe9_Upx>vb_q:U9'iπU"t70v.d)?9/O>o#fjnFP\>'aXO;/9]gW<FYrWp^hoQMhi2b?1m11Vdna-xmO%+nHπU"l(gPLWDzL,*lH[ZY%BeZw;W)90,&rk39*4A=>e#Su;5Xr=tU#QJ]GdtAYMf/U)WπU"rpgQRZEJFYs$el0()d)?>Z]H3EM*mT88*d$Y.^_$.E+81/tZdtc%8s(%1dxS.L7πU"9ljUowKtXm#;C/tQ>2ohGi/3]#Tm0=2\&K9%?:\_X#b$IlxgCW#dx\212>%BbHbπU"#kld%X>1G2f6HKJJJ.QF1giT+s)7M#&J,orfoDC3AUH&p5QW=^+.dAy\5#zJ/cvπU"rw8T?.nT7j#9qHZ&h$7,\4Py6':iL<F$+j*#sD7YctdY4'jF\)v5$GcF/[w*1.#πU"nz[Er[B,SiNKsj':P#?JMxRw/o9/vn=l84+#$9ga^VlNkJV%HAWjK9Z433;:\GGπU"(St0T>'G^_#V.vT^PA1)f#>4/_0,B4>E)e6g<1#)A]++/r4:_Ee%70vNoegoU$lπU"-r)s0QhB>S4Vwcb*2j45e0BMGWRbq'Y.6rNsUjNWV1dqx+u%mDZ4NDx<,dcY(j/πU"Hg(&.3g8^l$ny0x]6^u:U&_0>bNSg(>/\_%9vF+J]#M4WXh6dZ;J0)NO0]JP<&0πU"t9V<ifEV_Vmp%]Na,UB/]lid.&wi^MFcg]bB,(H;H-^BNuIsJ&8H<N:I0>*[\EfπU"NbnRZhuVO=]J=NJ6h-l3N%6iAPb5t3Us26i75,xH]94anw7:k4^*QJ(R0>$>#*WπU"<OVSLe(e.p>$lz)CI/JQtB/NDrJU9g8Zg58i3rr*c^$)E40eVIn1=q2p$Pf)u:QπU"iidgi\8)*aaqq\hY0i1W#CKP-r2Cdsvm#cIomkKA_22,.EW'F-,]I=nV+,E=(4DπU"5Y)-/h<]xMgbV\-KOk)>aLp$2_>4\1=7p09M_2d/PD(xH#CkjjO4U?x]vw<'LITπU"DQRr('3d$s=*J+gcOXmNINuTvl&Xxkp80k$^JSl'([1VmSU&0bwt<s6MgBbCU71πU"/&$^pM\HKb+DWtJH??*:1;<8,\)>k&ETEG(op?wsNJ%HpE6'6=[<o7_v:y;Ukr1πU";ej9^L:=OSfk==nU91SLT[eLWMQf#LCC6'\h.$=>REF32sto;M6Pilz+<=#OI=)πU"NX-_K$jp\MF&oghRJ\HB>NYpW(tO1n_b9c;?47*Y=3B.-cT4nwdil;Q0#ZKrPi$πU"t'dgeu((qiKu]sd;>88.&y/A;%W;X6&z*Xu[l5T070g%pM<7Mi<JipO<bOCR#RqπU"Zq46<9pR/mWG&P5bsXP[GL6-(GIV,7$^tZs&3TaP;(_,O>ape=[BZcg%bK$QI49πU"Rq(d#>TC(/i2Vz>U#rtiDC:,0rt.EaPv$acTKkw8R4Q:iZ7Z_Jy?as>cJ_22=h$πU"W<Gt.LIk#&\>Q*i.5Lq'Q*U.kJY(ajSY?EBpdgX0[F+SOD4(F^E-K)[W#-'yh+SπU"/DRr&KPYN#sB^rbLxmRs,_Pa3]Qm2CB/IiRf;p$EcW,#^73\a,6f%?e<<(rrMfTπU"<$9Py-oE+^2]2(DfHAERXXk7>7ieGzEn)D73*NY33T9&D7$Y'_R;I[BLeg\&.65πU"WU0bbyh=L#Z1>]Aapc4%nkqw]#C^g[zE]?,k&Wd96DiTRwRE6&us4%hVEIw$J]eπU"Rb;=%_MWL1T)lCl3w.]W>QtWiT[^0HIId,V,>AtVjYF;*_ye5cnQJG:<6XkM?fsπU"UOLUf42.z<Bc&Sx<iWL/,j=R>Vh]zqCjZ#uSjkNE4=d7o*p:M4\)<b8GM5i4#G?πU"_%DMDv[4o9RS8sC/n*s3c>rgP\/Nkp*;.F4fC_Hi5*Ki&7CAorj(-K#H;($Z$sOπU".&,muUjw9S5FLl32sMp3W/Av<qFv6JmWwq*mkUDZT]h<Ik'6VYG^1Hp1D7;ZYvWπU"0JCTj5AD)%qs)C<LNi2T$5E5aA*.Fn]zL\j^^YNQg&3G5OH42s3hUvp*?Q*5YX9πU"w1D==-kQSW2Np81(tk=bY,ajCs0f.-iDaiFUcDtH:PBk$hSrJug16)Gn$9kL6FKπU"=3[8GGL7mlu\wcwq%FCKC)zgG78nOJ>G=i[DOm&CbZD[]5$1k\mNvzQ.6vfT8GUπU"(qPe(oZ9g^H3jnHH[lVh3YB\QY7-eA+iRg0*'qB?kFseSDY-u%IZ0kBpAGmT0tkπU"5>x]ZjN2A9.2siFsLU)g0$)jwCq'?b4?RGC,Sezh*8Aa7bbcw,d21n-ho0FN48YπU"n^R9FFd(cV_;[><&k[Z/Q.Ou;-]+5^Y42K3D6_5+%$Ct;p1jFA77FEdAf1h0JD/πU"z2l%dVQSr<FKGZ\ltiLR5rNCjUN4AgOj=r<R6?7NxK[mupJ+W?gHUE_X2d];c.\πU"i(Z4UnjY/:TsIO59UhPSvbTsOQ((kDK0G<_:u2l9I&.9=wDT7qRr1w-A]JvjgWVπU"o&BI^fPbb2rhMJ.UXnU.W%v)J\s,7f*hNfnn7W>nI2.:;H:^bs3K2YhEhC5gC\oπU"ZZlL)?PBu;_k.C])&W/$&$b]#dcKlkl5DDG\ky]-Yc.&in]R?gnO%XU7.xFLNU,πU"x?SpS9VUJ)W*ggA6_b2sg&rOaW3?5ZY&'cTb-nxY<>0N7m_)9?c+#qIB^G.Sxu3πU"8O%t#:-lF+_MR,1Cvt)1CN7#q4)kE.+]]6mi>o'JX%'K=1/9<eF4IJZghs+3VU0πU"+5Eo]vG;7UqsD\gqTwNR<#:EC'uj%mv+6MqK0r4<k$8SKm/a<\wjKrfYE<ATZtXπU"cw3*UFA56VLZx$bV>?3J.QLL'V:I1k5/=RT^;rtsn9/G+k]OY.lv2B0W<2:#UeiπU"YtPM.^\/3fJfqfBZZBW\XW<W,hytPqFY4zBA7mgD%hnGlqWv+G&N=0%QB>a<rg*πU";TUnQGv=2cf,KrsETUlf>LDXJ5i*QX&4*2:)Q3Ft)))w?C(B1_vRZHohD9T[d_DπU"Ix-::x[.u=FSIl0HP&l'5*HiEW^HtDMXjy:\45t%)Ldv>Lo&=RCEo0,*h#x#]t-πU"a:T&N.g#x9vXslT6'ge>[7WoRVVhAV0u9?[Ni=D(u3?6R-cFw7#[HMA5DS\v^1qπU"];MCnr&28/0V-oTG.B'?JA'ju/xT<H>J,XD[Hj?Cv><*'/;'.xi:p_N<nhW>xxqπU"sPX\2myE.8.fr:4kd%d,+>Ql=sdXU[5rD=zD_%T(Ws21?%LcR_$3uYKe]xvZ&X#πU"uu&*c%T/wRzg.ow.Q;tEC.P7dlOsC^2qTo=x*+^x5P48dApb'[lI1pU6kSb+\9eπU"1ScB&_x#BWEN4bl]4?+cp'ic+JANy[:'b6/;j02bba#W.0GRx]qN(-WxAhk^hezπU"gL-g]cU?k=RoQBbA_\N0F'7zIfW,N2jBY,;t0OD#i5ExCSlwvXksm8vI&'fa&X_πU"xLa<vYD.RJfYJ<\s\osr7:-Uf+5qc9HF%>c:BsrG/^Hd;:p;2<qHclBK.rm.u2>πU"EB89(ZS8-Mj+l:meBJfelT\5D'H7.uctH-HteW_JL4:rgq*KP6PFvD:r_u5VLH?πU"[M$)Z+0Wok0DQ9fQY&c7co;IduvXv+se-J5=Lk=H#K7qWpI'lFnKII>b3LgaHa\πU";mGc9nrGIW2_]m.IDa9-*nz+#nFIT.LNUIG4ERh$Y=SLf:CF5+au-ILJ9JIGh=oπU"/A.]#lPk:b).]#%,MJAYDZ#d*o.ps7n\ckKCAqaOqCWilZLMX>_/M=[L.wyruB'πU"QDKg%OhZ7L2rtm*/\=o2BR\438PSPImI0jEB_?#v))Q5P2vpE:f^.s;1)++'aWEπU"8hj2JCpgQ0<+s=J5\raU5('?HLj%/vCa]7Oq1(Q*l;Xq#0u?=U8,M^)7*e&#I-2πU"eLrH0=Te:Gq<T70LVtoOpJfI,;9^oxI/C2xP'sPA5e#3]4V%-lHR,c,.F?)8P\FπU"hg7I[YB^7;/t?g/8Hk\3*cQzZGGd/6=W[NlT3zTQp3r_WZvgE2j[Ikg.r$K?v1GπU"agt_ww'$bBZ3_0Dp5%kXmKa6Lp3H+e%jbT0#2;c+2X-44[Y+s#7^N0x$-Vv)]+0πU"8bBQgj,Y/..zVL+8;rS#gh3-k#\zGlGiN\a2CwP,Xqj0x>DhQc#P^.nLT',d/rkπU"<BdPPG8&^xrvg3Tg;I-9DM':y,n#97X,[^rO&gi^aZ.Y]1J6fTWC].n=K7[fJY7πU"0'993Z[.HobsMid2*H6Py&tiDAd_]df*oc,<)7*+q.Il7&52b%CIljNISW0Lo:(πU"MJ#]nHa.0c#=_u9)wu+pih0.3ldK9,t22,_.r5)lD&2j^X'TYCU8%.CEhSz3N5kπU"P+ZR_CH]eR6a+1+Q+gman_SV-W'xK&<;Q;x$brX>x7K,:[H$X*fJ0SA7<xs-7k6πU"xj[TU[kJ8#LkJeda5+TXUhJ)bLt,8zI>)t$3Y>H[IJO/m>GdC=O='Eg43EC>*?JπU"9;W,QQh%jVYX.VN^3Yj?[+ng?_hsud*^QN;]Q:5>V1a;wC_b:akeB[f9di,=6ImπU">WrT7MiZDUW#oLLRhEqGE4b=j\v0a3kaQ'1FOT/=3Dk+FtuVDnotaEx($W71^L-πU"TL.=0F,_X3UxB,3A01d-RVU=X,BV<u6Sh322J1Jsn-S0.Rf<Eqq0n6;9^%fkG&.πU"prfT8:OY71BdVOewrQ%4gVx=rx7zT\SQ*,Ba9cZOI-i%U-nR<>'E0EN3(2(CM+IπU"NEbGZsd[0pb%JoCQ+Ne&kvs)p_p12V:jiqJ$<5dfEd-9(^P-+Z0ki.'=/sbFXQSπU"U,QG8_.15#-'+SaWoUD+OA3MG?IbRqK)d;b^^2N5KMqq3Vt*YKY#s8;&HELkr/,πU";0b+I$Z/b$S#eRe#E0I4sdE/g?.8rQs7T&1fm.XCK,VY2.#nemq9(1'7dLu7zw4πU"J.s,FfHI1*Th1[pVWL_<mZ:mcKo?TLSV9&8>LP$m:QjW)_BJdppk&h>J,sC]&#?πU"T12TGkdd]Tx#c5Cp&[EdK[k8F)ZA48q4iEoK\Td^6NEk752B1j)1cpgl\>t+i4'πU"45vIVf<&EEV]NnSLs.WwogW>d#s(M<M[\o)]u%g$;;>DCFEg1gFVg-91kVA^N=-πU"LA]M_]/)X[(A7%^sPHP2%\tGVM&GmVDB.cgutstpFdUYFj8V[6EIEWx-mEoo,;gπU"HXp'G>ta*ord6U/IgAjBh#X.1]KsNr+97Jrrw<Y11&(Vm6v.G%l-XOZXL%&7VK?πU"6v:/K-<D;dg8Hvgt_cdj-gX[8mMg.N1vQ*G82\YotpAVRLzUllV\zKBW#$[/pyrπU"y&HuhSZch_jjq^:;4[\3kV#;uk+A5IC,WIFK;y''^''XnLqh38N:'(Q'0K0.JlTπU"7GR?nOq4:n'3O$Rw^koBFmN7\rw4lQ$2o&0h2oknwRK/vxtTDMz.ZqK'(mFDMPlπU"Vyf=sCMeK3*B+A8Kx;$-DeZO'>12a;p>BB?t+_8N:-BP8h.RmY3K6r+KZkg;2$;πU"yj=;*$d7Cmrd$Zntko8ww=DeNUaqM-wJmu'cN(T*VrN;)A0SNd$KOO$CY/6]h)JπU"rEnidrwr191[r.hf;aDG>Fn8XcRPE+OElXbCIG:(9ltqQJiRl,1h?Lk'OM:tM-'πU":'qYCnjXX98P,s;y?m8n^MuZG'c(eDM1Pjw<F%Bge:K3r7RQowtniqA;(Z7584[πU"AWnU_5k*>:4JP-*g,\dj4i\t6k>1OZ+'X2&Ga46o0_yN&LZt04is$EBVDiVxV2JπU"q7:.Y;+cg5YYow$8'Y.UTBnWvPdd^MCH/;2CRkvP5v$y^9k8^Zl>t[hWtBm)TfSπU"Wf,b/?^swl/pKo,<vD)Vc;1y3yV%%;ZkifO8tme/1g7)]BJ-pEzm.Zz-8GBaqQ:πU"$etNDB>4bI]92RXkr:W#vF#b+DrH(ebnTCSG-P7:]YL=H02q+jmmrFDn-UA5([HπU"R215LiV84LGXI6#^DK1D2aiDc6[PfU_=dS#EFill]ckI[6-)4X(e&D2\B6Cjb_iπU"\b_JYef$Sd^LHSNxa%1*q^b<&igmW#KVKYZObLB-se_t)1UjBo8F(9Q>'8_oT&9πEND SUBπSUB V3πU"awuof&N)\KRFb5&3-wrKCpsqhcXa3-Z:Ol$UAs**t,/FsA(96(S;RUh[\oh.pjJπU"GSFS2KR4:L3o]P?j$[?_9kPLm-1tk#l7ANyBrhvy\GcFj$7KYq*WI=O%+oG3:G#πU"DVy6o4&fd3sv9B6kMHU?q\o]5zZ>WC=2quoffL^VKWY,joWjtiLeK]QYsHSEKkAπU"7_X\1S09S0],)AEm3Cf(Np\qax0w\qT_kkoZ30v:#S%zRM.uuEJpj05Le6uT$\LπU"u2m4GfP9QHUMx53q'xrtlRN:*.X(pN^TUfOK^27[8wk8b=8rpIw)Ul<V8n7BC,-πU"/SUh[ls9&8-&Xs)(d+B3QfwrHE&]Z?gCn)*KEAxO+R[3qT_FE=U3D4yAFl:DU5$πU"O_r53TsB.T0\,7=0iD$mwHT2eEd)KuAguJn^bo'r1C,&MZnU?^ZF0jWI8Y.F,jsπU"R=LTJAMoRGSxa/a1i:Lp'L_9?&7?jojuIXi\cU$7rq^+sSn]>)vVEg9WaUdSvXjπU"oj]G-V68](g_k3^Q_;l1kFa4Q41sGb^U&zS(UT9'Mm*DA?1=O:*jk1gDJ$Q[[tDπU"pAWsc9=3((8>PX)9=22>Ls3BtT>13xLsqOp)*Ag/P/xHBJ(K\6bPf-qxgAs)QZ<πU"';'/OP/H\dtmCdJ6N(W,%sy=&B]ap;7c-<P6ja,D[[4YW^:7SHC$\vWs09O6HxUπU"jBJ8bfE;iZ*%V9>pC_3t_TqtNBV2-3R6qZV2p9A'05t-vc+Ji:tU2n-VPrNG2KoπU"$tm=j0GKwI0L1sK5WXl4z*g='/vGOY2t*wf7QH24T#mE*Pfkb9$)O(Dm*o^XIqrπU"+qNM(R<R82JN=DikQ>kYw1*mqp]6cm9s&[*=*w#_k5ndeVoTN(IW^naBP^MQ'q3πU"r\(Jp7ty>]5<FZ0Q%Do2K.gOO=u)Y%4n-7CKo=t'+j)4H+k*\:M%$/mSUTJ'BBTπU"LqCxrMvy=j^_I$NQn'Ud_YOdsUoBe)T>=8yU9x+^ezy&C.a'CGO#1cnZOV<vIM/πU"=>me;1l5%a_B&TA)NBvSG&[KJ=I4JO_lpr.9sdQL[SU5v$9rT;dv1(6&)T:v5U-πU"&R9km4e8%C.X.p:2oJ7]Lcg3V,,.DbFe04V;]9dE$OnX1$7\;M%AGHm#ivYhZ*+πU"tf[y'HKArOU3[x4\a;$?:hVq=d)yb8i:u1^rpX[<Umj:6cZo43lifn5$Vy\c^NNπU"FAL]YKwWuXW8rA?_GEea=W(dXZ(.cTp>-NatJup3rH;XV#_q_U0fXasNvI$wgw2πU"A2An7p^DM)*MqHTuvOA]X+PF4YI4,gm1pLxF+4Q52/U+Us>k#IB3?G:=nV,aM+:πU"[od$%;:>Nde%B)Q]vKUDd3(<YclT6w]?.M\W>gg0urtd+[mpnMBB5n+xPTZwjWtπU"B_d&NVG#w#B7iQnl6mJ3Fo0+4lsTU-D=MBOSHQ-0*zO5eGeDYV'L%+;Uf17&Z==πU"J,AQv'AK3eDBI.sO'GM)p3\7#^P[YC;:8^YV+eN%x4:S3yJ_;+1(tzHdLrqXBa#πU"s<Q0#99;_D6VQEAm><[;M?'3ww&I;^*?vP&8l93STQj;'[jypnE_Rq;EW0qj5pEπU".]OLg[d^[dMIF;m#?3^lr*zW4P?P'<3TvhRQ<Ee0^+n_s3U='\/4eu4)DO4mp6DπU"#s\Oc7qYp<cedy_\v\E1BmTvMq5S.H\+(oYEQ<k'0X/Ymmn?AjeuhD,.2'n1V?1πU";ilpK(g:vCp^^U9o2gB78O#02jcE$i,4.ZUJ+w_*GnHGDj]J+m-dw)-vEDpApKcπU"&WU9.y=47V7Uswu<iY=bu4<feqi'j.7lM424Ld+7eTnF5W#+Jq3=IZSNkgipS>wπU"YB'PvYnPdg+n;s&uV?8'=[RQF&ja<'Np)8enBqR/^X8mhD0Yiw<Au'w>oV\7pJaπU"pwx=F=a7/5j;Cz?eDk*8aEa-n2%mQWVki\4\%0EaV\&:GSmY<_NDCaipq[[(]/6πU";*OjHOm1<TLzf=_og&'BtBRdp?]WC%>8CbXX,sT=QNu4n8xlnhNv%dup&%'9%9%πU"%%%-+%4sbCDu<X+\Zy%7%5r%%%+%%%%%%%%%&%E%%%%%%%%%x%ySgf%xup*%+%%πU"%%%&%&%%Y%%%%*z%%%%%πEND SUBπV2πV3πCLOSE:IF S=240AND B&=Z&THEN?" :) Ok!"ELSE?" :( Bad!πSUB U(A$):FOR A=1TO LEN(A$):C=ASC(MID$(A$,A))-37:IF C<0THEN C=91+C*32πIF K<4THEN K=C+243ELSE?#1,CHR$(C+(K MOD 3)*86);:K=K\3:B&=B&+1πS=(S+C)AND 255:NEXT:LOCATE,1:?STRING$(B&*50\Z&,219);:END SUBπ'>>> Page 1 of ST.ZIP ends here. Last page. TCHK:240πChristy Gemmell                PIPELINE REVISION              Martin Montes                  12-15-90 (00:00)       QB, QBasic, PDS        294  12061    PIPELINE.BAS' PIPELINE.BAS  a game for personal computers with Colour Graphics Adaptorπ'               or better.π'π'   Author:     Christy Gemmellπ'   Version:    3.10π'   Date:       15/12/1990π'π'   Compile:    BC /O pipeline;π'   Link:       LINK pipeline,,, qb.lib;π'   IDE:        QB pipeline.bas /L qb.qlbπ'   QBasic:     QBasic pipeline.bas π'π'   Converted from Borland TurboBASIC for use with Microsoft QuickBASIC.π'   Adapted and embellished from the original TRS-80 Colour Computer programπ'   by Martin Montes and the author.π'π'   $DYNAMICπ'π    DECLARE SUB ABSOLUTE (Ticks AS INTEGER, Address AS INTEGER)ππ    DECLARE SUB Centre (Row%, Text$)π    DECLARE SUB Continue ()π    DECLARE SUB Move (DX%, DY%)π    DECLARE SUB Pause (Ticks%)ππ    DIM SHARED MCode(1 TO 20) AS INTEGERπ    DEF SEG = VARSEG(MCode(1))π    OffSet% = VARPTR(MCode(1))π    RESTORE Codeπ    FOR I% = 0 TO 39π        READ Byte%π        POKE OffSet% + I%, Byte%π    NEXT I%π    DEF SEGππ    SCREEN 0: WIDTH 40: COLOR 15, 1: CLSπ    LOCATE , , 0: KEY OFF: RANDOMIZE TIMERπ    DIM SHARED E$(4), X0%(10), Y0%(10), HX%(30), HY%(30)π    K% = 1: L% = 3: PLAY "t240o3l8d#fgl8b-p8l8gl2b-": PLAY "mb":π    PLAY "l8t255o3bo4cdo3bo4co3abgaf#t120gbt200dp8t255o4cdecdo3bo4co3abg"π    PLAY "t120f#at200dp8t255ef#gdef#gef#g#aef#g#ag#abo4co3bo4cdeco3af#gd"π    PLAY "gbt120g": LOCATE 2, 8: PRINT "Silly Software Presents ..";π    LOCATE 10, 11: PRINT "+-----------------+";π    LOCATE 11, 11: PRINT "| P I P E L I N E |";π    LOCATE 12, 11: PRINT "+-----------------+";π    LOCATE 23, 11: PRINT "By Christy Gemmell";π    WHILE PLAY(1): WEND: PLAY "mf": COLOR 15, 0: CLSπ    FOR J% = 15 TO 1 STEP -1π        FOR I% = 1 TO J%π            LOCATE L%, 9: PRINT STRING$(25, 32);π            L% = L% + K%: COLOR I%π            LOCATE L%, 9: PRINT "Do you need Instructions?";π            Pause 1π        NEXT I%π        K% = -K%π    NEXT J%ππ    PLAY "l64t140o3deg#f#ggc#d#edc#ccaa#g#fc#"π    DOπ       COLOR 3: LOCATE 14, 18, 1π       PRINT "> "; : A$ = UCASE$(INPUT$(1))π    LOOP UNTIL A$ = "Y" OR A$ = "N"π π    IF A$ = "Y" THENπ       WIDTH 80: COLOR 14, 6: CLS : LOCATE , , 0π       LOCATE 1, 31: PRINT "+-----------------+";π       LOCATE 2, 31: PRINT "| P I P E L I N E |";π       LOCATE 3, 31: PRINT "+-----------------+";π       LOCATE 4, 1: PRINT STRING$(80, "-"); π       RESTORE Textπ       COLOR 30: LOCATE 2, 33: PRINT "P I P E L I N E";π       COLOR 0, 3: FOR R% = 5 TO 24: LOCATE R%, 2: PRINT SPACE$(78); : NEXTπ       FOR R% = 6 TO 20: READ Q$: Centre R%, Q$: NEXT: Continueπ       FOR R% = 5 TO 24: LOCATE R%, 2: PRINT SPACE$(78); : NEXTπ       FOR R% = 6 TO 21: READ Q$: Centre R%, Q$: NEXT: Continueπ    END IFππ    LOCATE , , 0π    DEF fnA% (A%) = INT((RND * A%)) * 16π    DEF fnB% (B%) = INT((RND * B%)) * 8π    E$(0) = "c2l16c0u0bu1br4r8bd2l8": E$(1) = "c2u8c0u0br2bd2d4bl4u4"π    E$(3) = "c2d8c0u0br2bu2u4bl4d4": E$(4) = "c2r16c0u0bu1bl4l8bd2r8"π    S$ = "bu2r4d4l8u4r4bd2": En$ = "bu2g2f2e2h2bd1"π    UA$ = CHR$(0) + CHR$(72): LA$ = CHR$(0) + CHR$(75)π    RA$ = CHR$(0) + CHR$(77): DA$ = CHR$(0) + CHR$(80)ππ    DOπ        SCREEN 1: Level% = 1: Pts% = 0π        LOCATE 2, 35: PRINT "Level"; : LOCATE 4, 37: PRINT "  1";π        LOCATE 7, 35: PRINT "Score"; : LOCATE 9, 37: PRINT "  0";π        LOCATE 12, 36: PRINT "Time"; : LOCATE 14, 37: PRINT "100";π        DOπ            X% = fnA%(15) + 15: Y% = fnB%(22) + 9: HX%(0) = X%: HY%(0) = Y%π            Time! = 100: LINE (2, 3)-(254, 182), 3, BFπ            Ep% = 5 + INT(RND * 4) + 1π            LINE (2, 3)-(254, 182), 2, B: LINE (0, 183)-(319, 199), 0, BFπ            FOR I% = 1 TO Ep%π               X0%(I%) = fnA%(14) + 23: Y0%(I%) = fnB%(21) + 5π            NEXT I%π            R$ = S$ + "br16": L$ = S$ + "bl16"π            U$ = S$ + " bu8": D$ = S$ + " bd8"π            R0$ = "br16;": FOR I% = 1 TO 14: R0$ = R0$ + R$: NEXTπ            L0$ = "bl16;": FOR I% = 1 TO 13: L0$ = L0$ + L$: NEXTπ            D0$ = " bd8;": FOR I% = 1 TO 20: D0$ = D0$ + D$: NEXTπ            U0$ = " bu8;": FOR I% = 1 TO 19: U0$ = U0$ + U$: NEXTπ            I% = 14: DRAW "c0bm15,9" + MID$(R0$, 5) + "x" + VARPTR$(S$)π            PLAY "l64o2t255egfd#d#c"π            DOπ                PLAY "ccc#gc#"π                DRAW LEFT$(D0$, (I% + 7) * 20 + 1) + "x" + VARPTR$(S$)π                PLAY "dad#": IF I% = 0 THEN EXIT DOπ                DRAW LEFT$(L0$, I% * 20 + 1) + "x" + VARPTR$(S$)π                PLAY "ebf"π                DRAW LEFT$(U0$, (I% + 6) * 20 + 1) + "x" + VARPTR$(S$)π                PLAY "f#o3d#o2g#"π                DRAW LEFT$(R0$, (I% - 1) * 20 + 1) + "x" + VARPTR$(S$)π                I% = I% - 2π            LOOP WHILE 1π            FOR I% = 0 TO Level%π                IF I% THENπ                   HX%(I%) = fnA%(15) + 15: HY%(I%) = fnB%(22) + 9π                END IFπ                PLAY "l60o1abeo5fda"π                Place$ = "bm" + STR$(HX%(I%)) + "," + STR$(HY%(I%))π                DRAW "x" + VARPTR$(Place$) + "c2s6x" + VARPTR$(S$)π            NEXT I%π            DRAW "s4": PAINT (X%, Y%), 1, 0: PLAY "o2l61df#eg#a"π            FOR I% = 1 TO Ep%π                Place$ = "bm" + STR$(X0%(I%)) + "," + STR$(Y0%(I%))π                DRAW "c0x" + VARPTR$(Place$) + "x" + VARPTR$(En$)π                Note$ = "n" + STR$(INT(RND * 11) + 1)π                PLAY "o4l58x" + VARPTR$(Note$)π            NEXT I%π            PLAY "l62o4t250dggdg#aao3dggdaa#a#o2dggda#bb"ππ            DOπ                I$ = INKEY$π                SELECT CASE I$π                    CASE UA$π                         Move 0, -1π                    CASE LA$π                         Move -1, 0π                    CASE RA$π                         Move 1, 0π                    CASE DA$π                         Move 0, 1π                    CASE CHR$(32)π                         PLAY "o1l64t255cdgf#c#c#c#d"π                         PAINT (HX%(0), HY%(0) + 1), 1, 0: I% = 1π                         DO WHILE I% <= Level%π                            IF POINT(HX%(I%), HY%(I%) + 1) <> 1 THENπ                               Place$ = "bm" + STR$(HX%(I%)) + "," _π                                      + STR$(HY%(I%))π                               DRAW "x" + VARPTR$(Place$)π                               FOR J% = 1 TO 27 + 2 * Level%π                                   PLAY "o5cdggb": DRAW "c2x" + VARPTR$(S$)π                                   PLAY "o4baffdc": DRAW "c1x" + VARPTR$(S$)π                               NEXT J%π                               Time! = 0: EXIT DOπ                            END IFπ                            I% = I% + 1π                         LOOPπ                         IF I% > Level% THENπ                             FOR I% = 2 TO 4π                                 Octave$ = "o" + STR$(I%)π                                 PLAY "l32x" + VARPTR$(Octave$) + "dfgg#"π                                 PAINT (HX%(0), HY%(0) + 1), 2, 0π                                 PLAY "g#d#fc#c"π                                 PAINT (HX%(0), HY%(0) + 1), 1, 0π                             NEXT I%π                             PLAY "t192l8o1cp32cl4p32cd#l8gp32gap32al4gl2d"π                             Pts% = Pts% + INT(Time!): Level% = Level% + 1π                             LOCATE 4, 36: PRINT USING "####"; Level%;π                             LOCATE 9, 36: PRINT USING "####"; Pts%;π                         END IFπ                         EXIT DOπ                    CASE ELSEπ                END SELECTπ                IF INT(RND * 20) + 1 = 1 THENπ                   I% = INT(RND * Ep%) + 1: L% = X0%(I%): M% = Y0%(I%)π                   I$ = "bm" + STR$(L%) + "," + STR$(M%)π                   DRAW "c0x" + VARPTR$(I$) + "x" + VARPTR$(En$)π                   IF (INT(RND * 2) + 1) = 1 THENπ                      J% = SGN(X% - L%): K% = 0π                   ELSEπ                      J% = 0: K% = SGN(Y% - M%)π                   END IFπ                   Place$ = "m" + STR$(L% + J% * 16) + "," _π                          + STR$(M% + K% * 8)π                   DRAW "x" + VARPTR$(I$) + "c0x" + VARPTR$(Place$) _π                        + "x" + VARPTR$(En$)π                   X0%(I%) = L% + J% * 16: Y0%(I%) = M% + K% * 8π                END IFπ                Pause 1: Time! = Time! - .1π                IF Time! >= 0 THENπ                   LOCATE 14, 36: PRINT USING "####"; INT(Time!);π                   Place$ = "bm" + STR$(INT(Time! * 2 + 5)) + ",185"π                   DRAW "c3x" + VARPTR$(Place$) + "r2d2l2u2"π                END IFπ            LOOP UNTIL Time! < 0π        LOOP WHILE Time! > 0π        LINE (0, 185)-(320, 200), 0, BFπ        LOCATE 24, 12, 1: PRINT "Another Game? > ";π        R$ = UCASE$(INPUT$(1))π    LOOP WHILE R$ = "Y"π    SCREEN 0, 0, 0: WIDTH 80: COLOR 15, 0: CLSπENDππ'   Centre a string of text within a screen row.π'πSUB Centre (Row%, Text$)π    LOCATE Row%, 40 - (LEN(Text$) \ 2): PRINT Text$;πEND SUBππ'   Prompt for a response from the user.π'πSUB Continueπ    LOCATE , , 1: Centre 23, "Press <ENTER> to continue > "π    DOπ       R$ = INPUT$(1)π    LOOP UNTIL R$ = CHR$(13)π    LOCATE , , 0πEND SUBππ'   Move in response to direction keys.π'πSUB Move (DX%, DY%)π    SHARED X%, Y%, Place$π    X% = X% + DX% * 16: Y% = Y% + DY% * 8π    IF X% < 15 THENπ       X% = 15: BEEPπ    ELSEIF X% > 239 THENπ       X% = 239: BEEPπ    ELSEIF Y% < 9 THENπ       Y% = 9: BEEPπ    ELSEIF Y% > 177 THENπ       Y% = 177: BEEPπ    ELSEπ       PLAY "o4l63e"π       Place$ = "bm" + STR$(X% - DX% * 16) + "," + STR$(Y% - DY% * 8)π       DRAW "x" + VARPTR$(Place$) + E$(DX% * 2 + DY% + 2)π    END IFπEND SUBππ'   System-independent time delayπ'πSUB Pause (Ticks%)π    DEF SEG = VARSEG(MCode(1))π    OffSet% = VARPTR(MCode(1))π    ABSOLUTE Ticks%, OffSet%π    DEF SEGπEND SUBππ'       Data Division.π'πCode:ππDATA  &H55, &H8B, &HEC, &H51, &H52, &H06, &H8B, &H5E, &H06, &H8B   πDATA  &H0F, &HE3, &H14, &H33, &HC0, &H8E, &HC0, &H26, &HA1, &H6CπDATA  &H04, &H50, &H26, &HA1, &H6C, &H04, &H5A, &H3B, &HC2, &H74πDATA  &HF6, &HE2, &HF4, &H07, &H5A, &H59, &H5D, &HCA, &H02, &H00ππText:ππDATA    "Your have been hired as the Chief Civil Engineer of"πDATA    "West Moronia and your job is to ensure that all the"πDATA    "towns and villages are provided with their supplies"πDATA    "of Natural Gas. The problem is that the countryside"πDATA    "is located on a big geological fault and is subject"πDATA    "to frequent earthquakes which fracture the pipeline"πDATA    "carrying the gas supplies.","  "πDATA    "At the beginning of each round, you will be shown a"πDATA    "map of one of your provinces, with it's chief towns"πDATA    "highlighted and the local pumping station filled in"πDATA    "with light blue. You must build a pipe joining this"πDATA    "pumping station to all the 'thirsty cities' of this"πDATA    "particular province, without any break or blockages"πDATA    "caused by earthquake activity."πDATA    "You construct the pipe using the Arrow keys to show"πDATA    "the direction in which you want it to go. Once that"πDATA    "you are confident you have a sound pipeline without"πDATA    "any breaks, hit the <SPACEBAR> to begin the flow of"πDATA    "gas through the system.","  "πDATA    "If a section is blocked due to earthquake activity,"πDATA    "the flow will look for an alternative route. If the"πDATA    "flow does not succeed in reaching all the locations"πDATA    "on the map then an alarm sounds, the 'thirsty city'"πDATA    "blinks and the game ends. If you manage to complete"πDATA    "the pipeline successfully in the time allotted, you"πDATA    "will begin the next round with a new province and a"πDATA    "new set of cities to service. a peculiarity of your"πDATA    "new homeland, incidentally, is that each successive"πDATA    "province has one more city than the last!"ππUnknown Author(s)              PAPER-SCISSORS-ROCK GAME       PB Revision                    Unknown Date           PB                     199  4047     ROCKPAP.BAS $IF 0π  ROCKPAP.BAS for PowerBASIC, adopted from PAPEROCK.BAS.π$ENDIFπ$LIB ALL OFFπDEFINT A-Zππblack = 0: blue = 1: green = 2: cyan = 3: red = 4: magenta = 5πyellow = 6: white = 7: bright = 8πCharge$ = "T240MFCfa>c.<a>l2C"ππbegin:π WIDTH 80π RANDOMIZE TIMERππ'SCREEN 9π COLOR white + bright, cyan         ' COLOR foreground, backgroundπ CLSπ LOCATE 5, 8, 1                     ' show cursor this screen!π PRINT "Would You Like To Play The Paper-Scissors-Rock Game...?";π DOπ  WHILE NOT INSTAT: WENDπ  Ans$ = UCASE$(INKEY$)π LOOP UNTIL TALLY (Ans$, ANY "YN" + CHR$(27))π PRINT Ans$π LOCATE , , 0                       ' hide cursorπ IF Ans$ <> "Y" THENπ   GOTO endingπ END IFππOne:πPLAY Charge$                        ' and set the tempo for future PLAY'sπLOCATE 11, 1πPRINT "       ... Press a Key to Play"πSLEEPπJunk$ = INKEY$                      ' empty the bufferππGAME:πCLSπLOCATE 2, 19πPRINT "Welcome To The Paper, Scissors, Rock Game!"πLOCATE 5, 17πPRINT "You pick either (P)aper, (S)cissors, or (R)ock"πLOCATE 7, 10πPRINT "and the computer will randomly select one of the other two."πLOCATE 9, 18πPRINT "Please press the Q key to (Q)uit at any time."πLOCATE 11, 25πPRINT "Now, What Do You Want... "πLOCATE 13, 30πPRINT "(P/S/R) "ππDOπ WHILE NOT INSTAT: WENDπ guess$ = UCASE$(INKEY$)πLOOP UNTIL TALLY (Guess$, ANY "RPSQ")ππIF guess$ = "P" THEN GOSUB paperπIF guess$ = "S" THEN GOSUB scissorsπIF guess$ = "R" THEN GOSUB rockπIF guess$ = "Q" THEN GOSUB endingππWHILE INSTAT: Junk$ = INKEY$: WEND'empty the bufferππGOTO GAMEππpaper:πx% = INT(RND * 9) + 1πIF x% > 5 THEN GOSUB winpπIF x% < 5 THEN GOSUB losesπIF x% = 5 THENπ Item$ = "Paper"π GOSUB TieBallGameπEND IFπRETURNππscissors:πx% = INT(RND * 9) + 1πIF x% > 5 THEN GOSUB winsπIF x% < 5 THEN GOSUB loserπIF x% = 5 THENπ Item$ = "Scissors"π GOSUB TieBallGameπEND IFπRETURNππrock:πx% = INT(RND * 9) + 1πIF x% > 5 THEN GOSUB winrπIF x% < 5 THEN GOSUB losepπIF x% = 5 THENπ  Item$ = "Rock"π  GOSUB TieBallGameπEND IFπRETURNππwinp:πCLSπLOCATE 8, 3πPRINT "You chose Paper..."πLOCATE 10, 4πPRINT "The computer chose Rock..."πLOCATE 12, 5πPRINT "Paper wraps rock... You WON!!! ";πPRINT CHR$(1)πPLAY "MF O3 L6 C C C L4 < G L6 > E E E C"πSLEEP 1πRETURNππwins:πCLSπLOCATE 8, 3πPRINT "You chose Scissors..."πLOCATE 10, 4πPRINT "The computer chose Paper..."πLOCATE 12, 5πPRINT "Scissors cut Paper... You WON!!! ";πPRINT CHR$(1)πPLAY "MF O3 L6 C C C L4 < G L6 > E E E C"πSLEEP 1πRETURNππwinr:πCLSπLOCATE 8, 3πPRINT "You chose Rock..."πLOCATE 10, 4πPRINT "The computer chose Scissors..."πLOCATE 12, 5πPRINT "Rock breaks Scissors... You WON!!! ";πPRINT CHR$(1)πPLAY "MF O3 L6 C C C L4 < G L6 > E E E C"πSLEEP 1πRETURNππlosep:πCLSπLOCATE 8, 3πPRINT "You chose Rock..."πLOCATE 10, 4πPRINT "The computer chose Paper..."πLOCATE 12, 5πPRINT "Paper wraps Rock... please try again..."πPLAY "MF O1 L4 G G L8 G L4 G L4 B- L8 A L4 A L6 G L4 G L6 F+ L4 G"πSLEEP 2πRETURNππloser:πCLSπLOCATE 8, 3πPRINT "You chose Scissors..."πLOCATE 10, 4πPRINT "The computer chose Rock..."πLOCATE 12, 5πPRINT "Rock breaks Scissors... please try again..."πPLAY "MF O1 L4 G G L8 G L4 G L4 B- L8 A L4 A L6 G L4 G L6 F+ L4 G"πSLEEP 2πRETURNππloses:πCLSπLOCATE 8, 3πPRINT "You chose Paper..."πLOCATE 10, 4πPRINT "The computer chose Scissors..."πLOCATE 12, 5πPRINT "Scissors cut Paper... please try again..."πPLAY "MF O1 L4 G G L8 G L4 G L4 B- L8 A L4 A L6 G L4 G L6 F+ L4 G"πSLEEP 2πRETURNππerrortrap:πLOCATE 19, 19πPRINT "Please type (P)aper, (S)cissors, or (R)ock  "πLOCATE 21, 22πPRINT "Press the Q key if you wish to (Q)uit"πPLAY "MF L6 O1 C A B C A"πSLEEP 2πRETURNππending:πCLSπLOCATE 10, 5πPRINT "Thanks For Playing... Good Bye!"πENDππTieBallGame:πCLSπLOCATE 8, 3πPRINT "You chose "; Item$; "..."πLOCATE 10, 4πPRINT "The computer chose "; Item$; "..."πLOCATE 12, 5πPRINT "No Winner!!! ";πPRINT CHR$(1)πPLAY Charge$πSLEEP 1πRETURNπππKurt Kuzba                     SIMPLE DICE GAME               FidoNet QUIK_BAS Echo          09/95 (00:00)          QB, QBasic, PDS        78   2956     DICEGAME.BAS'_|_|_|   DICE_EX.BASπ'_|_|_|   A simple dice game in BASIC, using the RND function.π'_|_|_|   Released to the   Public Domain   by Kurt Kuzbaπ'_|_|_|πDECLARE SUB DrawDice (vl%, x%, y%)πRANDOMIZE (TIMER + INP(64)): play$ = "yes"πWHILE play$ = "yes"π   COLOR 7, 0: CLSπ   LOCATE 3, 10: PRINT "SPACE to begin play, or RETURN to quit"π   k$ = "": WHILE k$ <> CHR$(13) AND k$ <> CHR$(32): k$ = INKEY$: WENDπ   IF k$ = CHR$(13) THENπ      play$ = "no"π   ELSEπ      player% = 0: computer% = 0π      COLOR 7, 0: CLS : COLOR 15, 1: LOCATE 9π      LOCATE , 23: PRINT "[][][][][][][][][][][][][][][][][][]"π      LOCATE , 23: PRINT "[]  Press SPACE to roll the die.  []"π      LOCATE , 23: PRINT "[]  Player #1       Computer      []"π      LOCATE , 23: PRINT "[]                                []"π      LOCATE , 23: PRINT "[]                                []"π      LOCATE , 23: PRINT "[]                                []"π      LOCATE , 23: PRINT "[]  Presently playing turn #      []"π      LOCATE , 23: PRINT "[][][][][][][][][][][][][][][][][][]"π      FOR turn% = 1 TO 10π         COLOR 15, 3π         LOCATE 11, 37: PRINT player%π         LOCATE 11, 52: PRINT computer%π         LOCATE 15, 52: PRINT turn%π         WHILE INKEY$ <> CHR$(32): WENDπ         FOR roll% = 1 TO 20π            vl% = ((RND * 999) MOD 6) + 1: DrawDice vl%, 12, 30π         NEXT: player% = player% + vl%π         FOR roll% = 1 TO 20π            vl% = ((RND * 999) MOD 6) + 1: DrawDice vl%, 12, 45π         NEXT: computer% = computer% + vl%π      NEXTπ   COLOR 15, 3π   LOCATE 11, 37: PRINT player%π   LOCATE 11, 52: PRINT computer%π   LOCATE 15, 52: PRINT turn%π   LOCATE 16, 23: COLOR 15, 1π   IF player% > computer% THENπ      PRINT "[]     You Won the Game!!         []"π   END IFπ   IF player% < computer% THENπ      PRINT "[]     The Computer Won!!         []"π   END IFπ   IF player% = computer% THENπ      PRINT "[]     It was a Tie Score.        []"π   END IFπ   LOCATE , 23: PRINT "[]     Hit RETURN to continue     []"π   LOCATE , 23: PRINT "[][][][][][][][][][][][][][][][][][]"π   WHILE INKEY$ <> CHR$(13): WENDπ   END IFπWENDπENDπSUB DrawDice (vl%, x%, y%)π   COLOR 15, 1: LOCATE x%π   d$ = "                     "π   WAIT &H3DA, 8: WAIT &H3DA, 8, 8π   LOCATE , y%: PRINT LEFT$(d$, 7)π   LOCATE , y%: PRINT MID$(d$, 8, 7)π   LOCATE , y%: PRINT RIGHT$(d$, 7)π   SELECT CASE vl%π      CASE IS = 1: d$ = "          O          "π      CASE IS = 2: d$ = " O                 O "π      CASE IS = 3: d$ = " O        O        O "π      CASE IS = 4: d$ = " O   O         O   O "π      CASE IS = 5: d$ = " O   O    O    O   O "π      CASE IS = 6: d$ = " O   O  O   O  O   O "π   END SELECTπ   COLOR 1, 7: LOCATE x%π   WAIT &H3DA, 8: WAIT &H3DA, 8, 8π   WAIT &H3DA, 8: WAIT &H3DA, 8, 8π   LOCATE , y%: PRINT LEFT$(d$, 7)π   LOCATE , y%: PRINT MID$(d$, 8, 7)π   LOCATE , y%: PRINT RIGHT$(d$, 7)πEND SUBπMike Beckman                   ROOM GAME                      [e-mail]             Unknown Date           QB, QBasic, PDS        118  2584     ROOMGAME.BASOPTION BASE 1π'this makes the lbound of all arrays default to 1, which is much easierπ'to work with over 0ππDIM room(57), north(57), east(57), south(57), west(57)ππCLSπl = 30πc = 1πWHILE c <= 57π   READ room(c), north(c), east(c), south(c), west(c)π   c = c + 1πWENDπππrooms:πPRINT "Room:"; room(l), "n"; north(l), "e"; east(l), "s"; south(l), "w"; west(l)ππPRINTπPRINT "You Can go ";ππIF north(l) <> 0 THENπ   PRINT "(n)orth ";πEND IFπIF east(l) <> 0 THENπ   PRINT "(e)ast ";πEND IFπIF south(l) <> 0 THENπ   PRINT "(s)outh ";πEND IFπIF west(l) <> 0 THENπ   PRINT "(w)est ";πEND IFπPRINT "(q)uit (?)redraw"πINPUT "Which way"; d$πIF d$ = "?" THEN GOTO rooms:πd$ = UCASE$(d$)πIF d$ = "N" AND north(l) <> 0 THEN l = north(l)πIF d$ = "S" AND south(l) <> 0 THEN l = south(l)πIF d$ = "E" AND east(l) <> 0 THEN l = east(l)πIF d$ = "W" AND west(l) <> 0 THEN l = west(l)πIF d$ = "Q" THEN END ELSE GOTO rooms:πππDATA 1,0,2,11,0πDATA 2,0,3,12,1πDATA 3,0,4,13,2πDATA 4,0,5,14,3πDATA 5,0,6,15,4πDATA 6,0,7,16,5πDATA 7,0,8,17,6πDATA 8,0,9,18,7πDATA 9,0,10,19,8πDATA 10,0,0,20,9πDATA 11,1,12,21,0πDATA 12,2,13,22,11πDATA 13,3,14,23,12πDATA 14,4,15,24,13πDATA 15,5,16,25,14πDATA 16,6,17,26,15πDATA 17,7,18,27,16πDATA 18,8,19,28,17πDATA 19,9,20,29,18πDATA 20,10,0,30,19πDATA 21,11,22,31,0πDATA 22,12,23,32,21πDATA 23,13,24,33,22πDATA 24,14,25,34,23πDATA 25,15,26,35,24πDATA 26,16,27,36,25πDATA 27,17,28,37,26πDATA 28,18,29,38,27πDATA 29,19,30,39,28πDATA 30,20,0,40,29πDATA 31,21,32,41,0πDATA 32,22,33,42,31πDATA 33,23,34,43,32πDATA 34,24,35,44,33πDATA 35,25,36,45,34πDATA 36,26,37,46,35πDATA 37,27,38,47,36πDATA 38,28,39,48,37πDATA 39,29,40,49,38πDATA 40,30,0,50,39πDATA 41,31,42,51,0πDATA 42,32,43,52,41πDATA 43,33,44,53,42πDATA 44,34,45,54,43πDATA 45,35,46,55,44πDATA 46,36,47,56,45πDATA 47,37,48,57,46πDATA 48,38,49,0,47πDATA 49,39,50,0,48πDATA 50,40,0,0,49πDATA 51,41,52,0,0πDATA 52,42,53,0,51πDATA 53,43,54,0,52πDATA 54,44,55,0,53πDATA 55,45,56,0,54πDATA 56,46,57,0,55πDATA 57,47,0,0,56ππ'this building looks like...π'π' 1- 2- 3- 4- 5- 6- 7- 8- 9-10π' |  |  |  |  |  |  |  |  |  |π'11-12-13-14-15-16-17-18-19-20π' |  |  |  |  |  |  |  |  |  |π'21-22-23-24-25-26-27-28-29-30π' |  |  |  |  |  |  |  |  |  |π'31-32-33-34-35-36-37-38-39-40π' |  |  |  |  |  |  |  |  |  |π'41-42-43-44-45-46-47-48-49-50π' |  |  |  |  |  |  |π'51-52-53-54-55-56-57π'π'As of now, all the rooms are easily connected, but by changing a few numbersπ'you can make someone have to take the long way around.πRez Beheshti                   3D TIC-TAC-TOE                 x2ftp.oulu.fi                  Year of 1982           QB, QBasic, PDS        400  13952    3DTTT.BAS   10  '********************************************π20  '*                                          *π30  '*           3D TIC-TAC-TOE                 *π40  '*                                          *π50  '*       (C) 1982 Reza Beheshti             *π60  '*                                          *π70  '*  3504 Pence Ct.                          *π80  '*  Annandale, VA.  22003                   *π90  '*  [phone]                          *π100 '*                                          *π110 '********************************************π120 'π130 ' System requirments:π140 'π150 ' IBM PC 64K MEM. Min.π160 ' 1 Disk driveπ170 ' Color/Graphic Boardπ180 ' 80 Column monitor (RGB Recommanded)π190 ' Run under "BASICA"π200 'π210 ' ------ ENJOY IT -----π220 'π230 'π240 'π250 'π260 SCREEN 1,0:KEY OFFπ270 ON ERROR GOTO 3720π280 CLS:RANDOMIZE 12π290 DEFINT A-Y:DEFDBL Z:DIM AA(3000),A(514),NAM$(11),LOS(11),WIN(11),SCR(11)π300 COLOR 0,0:Y=1:N=0:T=0:W=0:X=0:INSTFL=0:DIFFL=0:WELFL=0π310 IF DIFFL<> 0 THEN 700π320 DIFFL=1π330 GOSUB 3700π340 DRAW "c1bl90bu30r30f3d20g3f3d25g3l30"π350 DRAW "u5r24e3u21l25u5r25u20l27u3"π360 DRAW "br60bd30r40u4l40d4"π370 DRAW "bu4br60nu25d28r30e4u45h4l30"π380 DRAW "bu4r32f7d47g7l36u61r4"π390 DRAW "c2bl120bd2e15r25f3d32g3f3d19g9"π400 DRAW"u24h3e3u20h4l9"π410 DRAW "br59bd26e15r36d9g10u4l40" '- shadeπ420 DRAW "bu29br55e15r34f7d60g11l8e7u49h7l35" ' d shadeπ430 PAINT(110,100),2 '3 shadeπ440 PAINT(100,110),1 ' 3 itselfπ450 PAINT(150,99),1  '- itselfπ460 PAINT(150,82),2  ' - shadeπ470 PAINT(187,82),1 ' d shadeπ480 PAINT(230,70),2  ' d itselfπ490 LOCATE 22,12,0:PRINT" TIC - TAC - TOE"π500 Y1=5:Y2=Y1+32:FL=1:GOSUB 980π510 GET(65,45)-(250,133),AAπ520 FOR I=1 TO 800:NEXTπ530 GOSUB 3700π540 PUT (65,45),AA,XORπ550 XX=65:YY=65π560 FOR KI=1 TO 3π570 FOR K=1 TO 3π580 PUT (XX,YY),AA:XX=XX+15:YY=YY-15:NEXT Kπ590 FOR I=1 TO 700:NEXTπ600 XX=XX-15:YY=YY+15π610 GOSUB 3700π620 FOR K=1 TO 2π630 PUT (XX,YY),AA,XOR:XX=XX-15:YY=YY+15:NEXT Kπ640 NEXT KIπ650 DIFFL=1π660 GOSUB 3700π670 CLS:LOCATE 12,7,0:PRINT"WELCOM TO 3D TIC-TAC-TOE"π680 LOCATE 24,3,0:PRINT "(C) 1982  Reza Beheshti"π690 FOR I=1 TO 2500:NEXT Iπ700 FOR I=1 TO 514:A(I)=0:NEXT Iπ710 GOSUB 1310π720 SCREEN 1,0,0:CLSπ730 GOSUB 790π740 REM do human's moveπ750 REM see if tie game thoughπ760 YZ=YZ+1:IF (YZ=9)*(V=1)+(YZ=33)*(V>1) THEN 3260π770 GOSUB 1660π780 GOTO 1750π790 COLOR 1,0π800 Y1=10:Y2=Y1+32:FL=1π810 GOSUB 980π820 Y1=50:Y2=Y1+32:FL=1π830 GOSUB 980π840 Y1=90:Y2=Y1+32:FL=1π850 GOSUB 980π860 Y1=130:Y2=Y1+32:FL=1π870 GOSUB 980π880 LOCATE 1,22,0:PRINT"1   2   3   4"π890 LOCATE 2,18,0:PRINT"1"π900 LOCATE 3,16:PRINT"2"π910 LOCATE 4,14:PRINT"3"π920 LOCATE 5,12:PRINT"4"π930 LOCATE 3,37:PRINT"(1)"π940 LOCATE 8,37:PRINT"(2)"π950 LOCATE 13,37:PRINT"(3)"π960 LOCATE 18,37:PRINT"(4)"π970 RETURNπ980 LINE (160,Y1)-(272,Y1)π990 LINE -(205,Y2)π1000 LINE -(95,Y2)π1010 LINE -(160,Y1)π1020 IF FL=1 THEN PAINT (161,Y1+1),2,3π1030 LINE (188,Y1)-(123,Y2),3π1040 LINE (216,Y1)-(151,Y2),3π1050 LINE (244,Y1)-(179,Y2),3π1060 LINE (143,Y1+8)-(255,Y1+8),3π1070 LINE (126,Y1+16)-(238,Y1+16)π1080 LINE (110,Y1+24)-(222,Y1+24)π1090 RETURNπ1100 ENDπ1110 ' display X or O subroutineπ1120 ULX=160                    'upper left coord. of boardπ1130 ULY=(BORD-1)*40+10            'π1140 ULY=ULY+(ROW-1)*8            'upper left coord. of boxπ1150 ULX=ULX+(COL-1)*28-(ROW-1)*16  'π1160 IF FG=0 GOTO 1220π1170 IF FG=2 GOTO 1270π1180 ' print an Xπ1190 LINE (ULX,ULY)-(ULX+11,ULY+8),3   ' ul-lr lineπ1200 LINE (ULX-16,ULY+8)-(ULX+27,ULY),3 ' ll-ur lineπ1210 RETURNπ1220 ' Print an ellipseπ1230 FOR P=1 TO 15π1240 COLOR  ,0:CIRCLE (ULX+5,ULY+4),8,1,,,.36π1250 CIRCLE (ULX+5,ULY+4),8,0,,,.36:NEXT Pπ1260 RETURNπ1270 ' print the winning marks on scrennπ1280 GOSUB 3700π1290 COLOR ,1:CIRCLE (ULX+5,ULY+4),8,0,,,.2π1300 RETURNπ1310 SCREEN 0,0,0:COLOR 0,4,0π1320 WIDTH 80:CLSπ1330 LOCATE 3,15,0:PRINT"WELCOME TO ":COLOR 1 :LOCATE 3,28π1340 PRINT"T I C  -  T A C  -  T O E"π1350 IF INSTFL<>0 THEN 1540π1360 COLOR 2:INSTFL=1π1370 PRINT:PRINT TAB(5)"My name is ";:COLOR 1:PRINT"WIZY ";π1380 COLOR 2:PRINT"and I will be your opponent"π1390 PRINT:INPUT"What is your name";NA$π1400 LOCATE 7,5,0:PRINT:PRINT"Do you need instructions ";NA$π1410 INPUT K$:K$=LEFT$(K$,1)π1420 IF K$="y" OR K$="n" OR K$="Y" OR K$="N" THEN 1460π1430 BEEP:PRINT "Please answer with a YES or NO":FOR I=1 TO 950:NEXTπ1440 FOR J=8 TO 10:LOCATE J,1,0:PRINT"                                      ":NEXT Jπ1450 GOTO 1400π1460 IF K$="n" OR K$="N" THEN 1540π1470 PRINT:PRINT TAB(3)"3-D TIC-TAC-TOE is played on four boards. You must get 4 in"π1480 PRINT TAB(3)"a row to win. (Horizonal, Vertical, or Diagonally)"π1490 PRINT TAB(3)"There are 4 rows and 4 columns on each board, you enter your choice of"π1500 PRINT TAB(3)"box by a three digit number indicating the row, column, and board number"π1510 PRINT TAB(3)" i.e. [231] is row 2, column 3, on board 1"π1520 PRINT TAB(3)"You will play the 'X' and I will take 'O' and I let you play first"π1530 INSTFL=1π1540 LOCATE 18,3,0:PRINT"There are 2 versions available as follows:"π1550 PRINT TAB(5)"1) Moderately hard to beat"π1560 PRINT TAB(5)"2) Hardest to beat"π1570 LOCATE 21,3,0:PRINT NA$;" Which one would you like";:INPUT Vπ1580 IF V>0 AND V<3 THEN 1620π1590 BEEP:PRINT"Please chose 1 or 2 only":FOR I=1 TO 999:NEXTπ1600 FOR K=21 TO 24:LOCATE K,1:PRINT"                                    ":NEXTπ1610 GOTO 1570π1620 LOCATE 25,3,0:PRINT"One moment.."π1630 GOSUB 3360π1640 V=V+1:LOCATE 25,2,0:PRINT"Hit [ENTER] to start";:BEEP:INPUT XXXπ1650 SCREEN 1,0,0:RETURNπ1660 REM Input query starts here.π1670 CODE=0:LOCATE 23,3,0:INPUT"Which box [RCB]";BOX$π1680 GOSUB 1790   ' to subroutine for valid input checkπ1690 IF CODE=1 THEN 1670π1700 GOSUB 1980π1710 IF A(D)<>0 THEN 3600π1720 A(D)=1:FG=1:GOSUB 1110π1730 LOCATE 23,1,0:PRINT" I'm thinking .......       ":FOR I=1 TO 1500:NEXT Iπ1740 RETURNπ1750 REM evaluate all movesπ1760 GOSUB 2620π1770 GOSUB 2090                  ' do computers moveπ1780 GOTO 750                    ' to -> see if tie game thoughπ1790 ' Subroutine to check VALID input from the player.π1800 LN=LEN(BOX$):IF LN=3 THEN 1840π1810 BEEP:LOCATE 23,24,0:BEEP:PRINT"Bad Input":FOR I=1 TO 1500:NEXTπ1820 LOCATE 23,15,0:PRINT"                    "π1830 CODE=1:RETURNπ1840 R$=MID$(BOX$,1,1):ROW=VAL(R$)π1850 C$=MID$(BOX$,2,1):COL=VAL(C$)π1860 B$=MID$(BOX$,3,1):BORD=VAL(B$)π1870 RER$=" ":CER$=" ":BER$=" "π1880 IF ROW<1 OR ROW>4 THEN RER$=" ROW   "π1890 IF COL<1 OR COL>4 THEN CER$=" COLUMN"π1900 IF BORD<1 OR BORD>4 THEN BER$=" BOARD "π1910 IF RER$=" " AND CER$=" " AND BER$=" " THEN RETURNπ1920 CODE=1π1930 LOCATE 23,1,0π1940 BEEP:PRINT"Invalid  "+RER$+CER$+BER$+"    "π1950 FOR I=1 TO 2000:NEXT:LOCATE 24,1,0π1960 LOCATE 23,1,0:PRINT"                                 ":RETURNπ1970 ' **** Subroutine to convert to RCB inputπ1980 CON1=(BORD-1)*16π1990 CON2=(COL-1)*4π2000 D=CON1+CON2+ROWπ2010 RETURNπ2020 ' ******* Subroutine to convert from RCBπ2030 ZUM1=D/16:BORD=INT(ZUM1+.9899999)π2040 B1=BORD-1:B2=B1*16:B3=D-B2:ZUM1=B3/4:COL=INT(ZUM1+.9899999)π2050 B5=COL-1:B6=B5*4:ROW=B3-B6π2060 RETURNπ2070 REMπ2080 REM---main logic subroutines---π2090 REM make computer move.π2100 REMπ2110 REM see if we have a must block conditionπ2120 IF (YZ<3)*(V>1)+(YZ=1) THEN 2560π2130 IF Q=0 THEN 2200π2140 FOR G=0 TO 3π2150 E=A(65+G+(Q-1)*4)π2160 REM find empty box to block withπ2170 IF A(E)=0 THEN K=E : G=4π2180 NEXT Gπ2190 GOTO 2590π2200 REM clear box value arrayπ2210 FOR I=1 TO 64 : A(450+I)=0:NEXT Iπ2220 REM if u=0 then cats gameπ2230 U=0π2240 REM compute value for each box as it appears in the win arrayπ2250 FOR I=1 TO (-10*(V=1)-76*(V<>1)) STEP (1-3*(V=2))π2260 B=A(370+I)π2270 REM if value of win combo is zero then forget itπ2280 IF B=0 THEN U=1:GOTO 2460π2290 REM get strategy value of this win combo in fπ2300 F=0π2310 IF (B=1) + (B=5) THEN F=1π2320 IF B=2 THEN F=4π2330 IF B=3 THEN STOPπ2340 IF B=10 THEN F=2π2350 IF F=0 THEN 2460π2360 U=1π2370 REM increment each box in win combo by win valueπ2380 E=(I-1)*4+65π2390 FOR G=0 TO 3π2400 REM get box number in cπ2410 C=A(E+G)π2420 REM see if this box is usedπ2430 IF A(C) <> 0 THEN 2450π2440 A(450+C)=A(450+C)+Fπ2450 NEXT Gπ2460 NEXT Iπ2470 REM see if cats gameπ2480 IF (U=0)*(V<>2) THEN 3260π2490 REM get best box nowπ2500 L=0π2510 FOR I=1 TO 64π2520 IF A(450+I)>L THEN L=A(450+I):K=Iπ2530 NEXT Iπ2540 REM see if any move found. if not do a random moveπ2550 IF L>0 THEN 2590π2560 GOSUB 3660π2570 IF A(I)=0 THEN K=I:GOTO 2590π2580 GOTO 2560π2590 REM do computer move in kπ2600 GOSUB 2970π2610 RETURNπ2620 REMπ2630 REM evaluate all movesπ2640 REMπ2650 Q=0:R=0π2660 REM skip first move on version 1π2670 IF (YZ<3)*(V>1) THEN 2870π2680 K1LL=0 'if set then we are to get out of do loopπ2690 FOR I=1 TO (V<>1)*-76+(V=1)*-10π2700 IF K1LL=1 THEN 2840  'human won, we done! if wizy won .                        keep checking to make sure human didn't win first.π2710 E=(I-1)*4+65π2720 F=370+Iπ2730 C=0π2740 FOR J=0 TO 3π2750 C=C+A(A(J+E))π2760 NEXT Jπ2770 REM see if wizy lostπ2780 A(F)=Cπ2790 IF C=4 THEN R=I:K1LL=1:GOTO 2840π2800 REM must block if human has three in a rowπ2810 IF C=3 THEN Q=Iπ2820 REM see if comy wonπ2830 IF C=15 THEN R=I:K1LL=2:GOTO 2840π2840 NEXT Iπ2850 IF K1LL=1 THEN 3230π2860 IF K1LL=2 THEN 2890π2870 RETURNπ2880 REM wizy won. find empty box!π2890 FOR H=0 TO 3π2900 C=A(65+H+(R-1)*4)π2910 IF A(C)=0 THEN K=C:H=4π2920 NEXT Hπ2930 REM do wizy moveπ2940 GOSUB 2970π2950 REM wizy won.π2960 GOTO 3050π2970 REMπ2980 REM do wizy move specify in kπ2990 REMπ3000 D=K:A(D)=5π3010 GOSUB 2020π3020 FG=0:GOSUB 1110π3030 LOCATE 23,1,0:PRINT"COMPY takes box ";ROW;COL;BORD:FOR I=1 TO 4000:NEXTπ3040 GOSUB 3630:RETURNπ3050 REMπ3060 REM wizy won/lostπ3070 REMπ3080 FG=2:GOSUB 3300    ' subroutine to mark thru winning boxesπ3090 LOCATE 23,1,0:PRINT"HURRAH I WON !!!";:X=X+1:FOR I=1 TO 9000:NEXTπ3100 CLS:LOCATE 4,1,0:PRINT"Wins: ";W;" Losses: ";X;" Ties: ";Tπ3110 LOCATE 7,2,0:PRINT"Do you want to play again ";NA$π3120 INPUT AN$:AN$=LEFT$(AN$,1)π3130 IF AN$="y" OR AN$="Y" THEN 310π3140 IF AN$="n" OR AN$="N" THEN 3180π3150 BEEP:LOCATE 10,3,0:PRINT"Yes/No please":FOR I=1 TO 1500:NEXTπ3160 LOCATE 10,3,0:PRINT"               "π3170 GOTO 3110π3180 CLS:LOCATE 9,1,0:PRINT"I liked playing with you..."π3190 PRINT:PRINT"See you soon!"π3200 LOCATE 23,1,0π3210 CLS:RUN "MENU.PGM"π3220 REM wizy lostπ3230 FG=2:GOSUB 3300  ' *********  mark the winning boxesπ3240 LOCATE 23,1,0:PRINT"BOO-HOO I LOST .....":W=W+1:FOR I=1 TO 9000:NEXT Iπ3250 GOTO 3100π3260 LOCATE 23,1,0:PRINT"Tie game ...":FOR I=1 TO 9000:NEXT Iπ3270 GOSUB 3630π3280 GOTO 3100π3290 REMπ3300 REM mark thru winsπ3310 REMπ3320 FOR H=0 TO 3:D=A(65+H+(R-1)*4)π3330 GOSUB 2020  ' convert d to rcbπ3340 F=2:GOSUB 1110  ' mark thru winsπ3350 NEXT H:RETURNπ3360 REMπ3370 REM setup win arrayπ3380 REMπ3390 RESTOREπ3400 FOR I=1 TO 10:FOR C=0 TO 3:READ A(65+C+(I-1)*4):NEXT C:NEXT Iπ3410 FOR I=57 TO 76:FOR C=0 TO 3π3420 READ A(65+C+(I-1)*4)π3430 NEXT C:NEXT Iπ3440 FOR I=1 TO 3:FOR C=1 TO 10:FOR E=0 TO 3π3450 A(E+65+(C+I*10-1)*4)=A(E+65+(C-1)*4)+16*Iπ3460 NEXT E:NEXT C:NEXT Iπ3470 FOR I=41 TO 56:FOR C=0 TO 3π3480 A(65+C+(I-1)*4)=C*16+I-40:NEXT C:NEXT Iπ3490 RETURNπ3500 DATA 1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,1,5,9,13,2π3510 DATA 6,10,14π3520 DATA 3,7,11,15,4,8,12,16,1,6,11,16,4,7,10,13,1,22,43,64π3530 DATA 5,22,39,56,9,26,43,60,13,26,39,52,2,22,42,62,14,26π3540 DATA 38,50π3550 DATA 3,23,43,63,15,27,39,51,4,23,42,61,8,23,38,53,12,27π3560 DATA 42,57,16,27,38,49π3570 DATA 1,21,41,61,1,18,35,52,4,19,34,49,4,24,44,64π3580 DATA 13,25,37,49,13,30,47,64,16,31,46,61,16,28,40,52π3590 REMπ3600 LOCATE 23,1,0:BEEP:PRINT"Box already taken!":FOR I=1 TO 1500:NEXT Iπ3610 GOSUB 3630π3620 GOTO 1670π3630 ' subroutine to clean up line 23 on screenπ3640 LOCATE 23,1,0:PRINT"                              "π3650 RETURNπ3660 Z1=(RND*100)π3670 I=INT(Z1):IF I<1 OR I>64 THEN 3660π3680 RETURNπ3690 REM Subroutine to play the musicπ3700 PLAY "MBL12T128O3CDEFGABFEDCBADO4C"π3710 RETURNπ3720 REM error handling routineπ3730 CLSπ3740 IF ERR=53 THEN 3830π3750 IF ERR=61 THEN 3860π3760 IF ERR=70 THEN 3910π3770 IF ERR=71 THEN 3940π3780 IF ERR=73 THEN 3970π3790 XX=ERRπ3800 PRINT:PRINT"UNEXPECTED error number [";XX;"]"π3810 PRINT:PRINT"Please look it up in your basic manual"π3820 PRINT" in Appendix A.":ENDπ3830 PRINT" Seems like you have the wrong disk in drive 'A`"π3840 PRINT "Please double check it."π3850 GOTO 3990π3860 PRINT"Opps... Your disk space is full, please make "π3870 PRINT" sure you have the right diskette in drive 'A`"π3880 PRINT" or you have to erase some data from the diskette"π3890 PRINT" in drive 'A` before you could save any more data on it."π3900 GOTO 3990π3910 PRINT" Diskette write protection notch is covered and I can "π3920 PRINT"not record your score unless you remove it."π3930 GOTO 3990π3940 PRINT" Drive 'A` is not ready, please insert the right "π3950 PRINT "diskette in, or make sure the drive door is closed."π3960 GOTO 3990π3970 PRINT" Advanced BASIC is required. Please load BASICA and rerun"π3980 ENDπ3990 PRINT:PRINTπ4000 endπFrederick Volking              MAD MAD MAD MAZES              x2ftp.oulu.fi                  Year of 1989           QB, QBasic, PDS        635  22555    MADMAZES.BASCLSπLOCATE 25,1πPRINT "MAD MAD MAD MAZES!   Copyright 1989 Frederick Volking   Version: 1.0";ππLOCATE 13,20 : PRINT "         <C> = Color Graphics Adapter (CGA)";πLOCATE 14,20 : PRINT "         <E> = Enhanced Graphics Adapter (EGA)";πLOCATE 15,20 : PRINT "         <V> = Video Graphics Adapter (VGA)";πLOCATE 11,20 : PRINT "Which Graphics Adapter? : ";πDO : GMode$ = INKEY$ : LOOP WHILE (GMODE$ = "")πIF GMode$ = "" THEN ENDπGMode$ = UCASE$(GMode$)πIF INSTR("CEV",Gmode$) = 0 THEN ENDπIF GMode$ = "C" THEN GMode% = 2πIF GMode$ = "E" THEN GMode% = 8πIF GMode$ = "V" THEN GMode% = 12π'================================== Initialize Hardware & Random Seed GeneratorπScreen GMode%πScoreFile$ = "MAZESCOR.DAT"πDEFINT A-ZπK% = VAL(MID$(DATE$,4,2))+VAL(RIGHT$(TIME$,2))+VAL(LEFT$(TIME$,2))+VAL(MID$(TIME$,4,2))πRandomize K%π'============================================ Define Static Substitution Macrosπ%FALSE  = 0π%TRUE   = 1π%UP     = 1π%LEFT   = 2π%DOWN   = 3π%RIGHT  = 4ππ%OUP    = 1π%ORIGHT = 2π%ODOWN  = 4π%OLEFT  = 8π%TUP    = 16π%TRIGHT = 32π%TDOWN  = 64π%TLEFT  = 128π'====================================================== Define Default settingsπIF GMode% = 2 THENπ   Xaxis% = 191 : Yaxis% = 639πEND IFπIF GMode% = 8 THENπ   Xaxis% = 191 : Yaxis% = 639 : PcolorON% = 3πEND IFπIF GMode% = 12 THENπ   Xaxis% = 380 : Yaxis% = 639 : PcolorON% = 3πEND IFπDIM STATIC HighTimes&(10),Whose(10)πIF GMode% = 2 THENπ   TokenColor% = 1π   CrumbColor% = 1π   WallColor% = 1πELSEπ   TokenColor% = 12π   CrumbColor% = 11π   WallColor%  = 7π   GOSUB SetUpColorsπEND IFπCmd$ = UCASE$(COMMAND$)πCountDown% = %TRUEπ'===================================================== Main Program Loop BeginsπCycle% = 1πWHILE (Cycle% < 11)π   CLSπ   SELECT CASE Cycle%π      CASE =  1 : CellSize% = 30π      CASE =  2 : CellSize% = 25π      CASE =  3 : CellSize% = 20π      CASE =  4 : CellSize% = 15π      CASE =  5 : CellSize% = 12π      CASE =  6 : CellSize% = 9π      CASE =  7 : CellSize% = 7π      CASE =  8 : CellSize% = 5π      CASE =  9 : CellSize% = 3π      CASE = 10 : CellSize% = 2π   END SELECTπ   GOSUB PrintLine25π   '=========================================== Calculate global default valuesπ   CellsTall%   = ( FIX(Xaxis% / CellSize%))π   CellsWide%   = ( FIX((Yaxis% / CellSize%) / 2 ))π   FrameBottom% = (CellsTall% * CellSize%)π   FrameRight%  = (CellsWide% * (CellSize% * 2))π   WallsToDraw% = ((CellsTall%+1) * (CellsWide%+1)) - ((CellsTall%+CellsWide%) * 2 )π   '============================================== Dimension appropriate arraysπ   DIM DYNAMIC Walls%(CellsTall%,CellsWide%)π   '=================================================== Initialize array valuesπ   FOR C% = 0 to CellsWide%π      Walls%(0,C%) = 1π      Walls%(CellsTall%,C%) = 1π   NEXTπ   FOR C% = 0 to CellsTall%π      Walls%(C%,0) = 1π      Walls%(C%,CellsWide%) = 1π   NEXTπ   '================================================================= Draw mazeπ   GOSUB DrawMazeπ   ERASE Walls%π   DIM DYNAMIC Pfield%(CellsTall%+1,CellsWide%+1)π   '============================================================ One Maze Cycleπ   DoorOut% = (FnR%(CellsTall%-2))+1π   LINE (0,DoorOut%*CellSize%) - (0,(DoorOut%*CellSize%)+(CellSize%)), 0π   OriginX% = (FnR%(CellsTall%-2))+1π   CurX% = OriginX%π   CurY% = CellsWide%π   LastCurX% = CurX%π   LastCurY% = CurY%π   IF Cmd$ = "DEMO"  THENπ      KeepGoing% = %FALSEπ      AutoSolve% = %TRUEπ   ELSEπ      KeepGoing% = %TRUEπ      AutoSolve% = %FALSEπ   END IFπ   INCR DoorOut%π   MazeIsDrawn% = %TRUEπ   BeginTimer! = TIMERπ   WHILE (KeepGoing%)π      IF PField%(CurX%,CurY%) = 1 THENπ         CALL DrawPiece(LastCurX%,LastCurY%,0,0)π         PField%(LastCurX%,LastCurY%) = 0π      ELSEπ         CALL DrawPiece(LastCurX%,LastCurY%,TokenColor%,1)π      END IFπ      CALL DrawPiece(CurX%,CurY%,TokenColor%,0)π      PField%(CurX%,CurY%) = 1π      LastCurX% = CurX%π      LastCurY% = CurY%π      DOπ         K$ = INKEY$π         GOSUB ShowElapsedπ      LOOP WHILE (K$ = "")π      IF (LEN(K$) = 2) THEN K% = 1000 ELSE K% = 0π      K% = K% + ASC(RIGHT$(K$,1))π      Xnext% = CurX%π      Ynext% = CurY%π      SELECT CASE K%π         CASE 1072 : DECR Xnext%           ' Upπ         CASE 1077 : INCR Ynext%           ' Rightπ         CASE 1080 : INCR Xnext%           ' Downπ         CASE 1075 : DECR Ynext%           ' Leftπ         CASE   27 : GOSUB ExitRequested   ' ESCπ      END SELECTπ      IF ((Xnext% = DoorOut%) AND (Ynext% = 0)) THENπ         KeepGoing% = %FALSEπ      ELSEπ         IF FnBlocked%(CurX%,CurY%,XNext%,Ynext%) THENπ            XNext% = CurX%π            YNext% = CurY%π         END IFπ      END IFπ      CurX% = Xnext%π      CurY% = Ynext%π   WENDπ   MazeIsDrawn% = %FALSEπ   IF AutoSolve% THENπ      BeginTimer! = TIMERπ      GOSUB YouDoItπ      GOSUB ShowTotalMazeTimeπ      IF Cmd$ = "DEMO" THENπ         W% = FnStartTimer%(10)π         WHILE FnSecondsElapsed%(25,70) > 0π            IF INKEY$ > "" THEN GOSUB ExitRequestedπ         WENDπ      ELSEπ         LOCATE 25,1 : PRINT SPACE$(79);π         LOCATE 25,21 : PRINT "Press <ANY KEY> to return to DOS";π         WHILE INKEY$ = "" : WENDπ         CLSπ         ENDπ     END IFπ   ELSEπ      GOSUB ShowTotalMazeTimeπ   END IFπ   ERASE Pfield%π   INCR Cycle%π   IF Cmd$ = "DEMO" THENπ      IF Cycle% = 11 THEN Cycle% = 1π   END IFπWENDπLOCATE 25,1 : PRINT SPACE$(79);πLOCATE 25,21 : PRINT "Press <ANY KEY> to return to DOS";πWHILE INKEY$ = "" : WENDπEND 'of main program loopπ'==============================================================================π'===================== Functions & Subroutines Begin ==========================π'==============================================================================π'================================================ Define Random Number FunctionπDEF FnR%(X%) = INT(RND * X%) + 1π'=================================================== Automatically solve a mazeπYouDoIt:π   '========================================= Erase old path & return to originπ   KeepBacking% = %Trueπ   WHILE KeepBacking%π      PField%(CurX%,CurY%) = 0π      CALL DrawPiece(CurX%,CurY%,0,0)π      IF ((CurX% = OriginX%) AND (CurY% = CellsWide%)) THENπ         KeepBacking% = %FALSEπ      ELSEπ         Trim% = 0π         IF FnBlocked%(CurX%,CurY%,CurX%-1,CurY%  ) = %FALSE THEN _π            IF (PField%(CurX%-1,CurY%  ) = 1) THEN Trim% = %UPπ         IF FnBlocked%(CurX%,CurY%,CurX%  ,CurY%-1) = %FALSE THEN _π            IF (PField%(CurX%  ,CurY%-1) = 1) THEN Trim% = %LEFTπ         IF FnBlocked%(CurX%,CurY%,CurX%+1,CurY%  ) = %FALSE THEN _π            IF (PField%(CurX%+1,CurY%  ) = 1) THEN Trim% = %DOWNπ         IF FnBlocked%(CurX%,CurY%,CurX%  ,CurY%+1) = %FALSE THEN _π            IF (PField%(CurX%  ,CurY%+1) = 1) THEN Trim% = %RIGHTπ         SELECT CASE Trim%π            CASE %UP    : DECR CurX%π            CASE %LEFT  : DECR CurY%π            CASE %DOWN  : INCR CurX%π            CASE %RIGHT : INCR CurY%π         END SELECTπ      END IFπ   WENDπ   '================================================================ Solve Mazeπ   AllTested% = %TUP + %TRIGHT + %TDOWN + %TLEFTπ   PField%(CurX%,CurY%) = %ORIGHT + %TRIGHTπ   NotFoundYet% = %TRUEπ   MazeIsDrawn% = %FALSEπ   IF Cmd$ = "DEMO" THENπ      CALL DrawPiece(CurX%,CurY%,TokenColor%,0)π      W% = FnStartTimer%(10)π      WHILE FnSecondsElapsed%(25,70) > 0π         IF INKEY$ > "" THEN GOSUB ExitRequestedπ      WENDπ   END IFπ   DOπ      IF INKEY$ > "" THEN GOSUB ExitRequestedπ      GOSUB ShowElapsedπ      IF ((PField%(LastCurX%,LastCurY%) AND AllTested) = AllTested) THEN _π         CALL DrawPiece(LastCurX%,LastCurY%,0,0) _π      ELSE CALL DrawPiece(LastCurX%,LastCurY%,TokenColor%,1)π      CALL DrawPiece(CurX%,CurY%,TokenColor%,0)π      LastCurX% = CurX%π      LastCurY% = CurY%ππ      IF ((PField%(CurX%,CurY%) AND %TUP) <> %TUP) THENπ         IF FnBlocked%(CurX%,CurY%,CurX%-1,CurY%) = %TRUE THENπ            PField%(CurX%,CurY%) = PField%(CurX%,CurY%) + %TUPπ         ELSEπ            IF ((PField%(CurX%-1,CurY%) AND AllTested%) = AllTested%) THEN _π               PField%(CurX%,CurY%) = PField%(CurX%,CurY%) + %TUPπ         END IFπ      END IFππ      IF ((PField%(CurX%,CurY%) AND %TDOWN) <> %TDOWN) THENπ         IF FnBlocked%(CurX%,CurY%,CurX%+1,CurY%) = %TRUE THENπ            PField%(CurX%,CurY%) = PField%(CurX%,CurY%) + %TDOWNπ         ELSEπ            IF ((PField%(CurX%+1,CurY%) AND AllTested%) = AllTested%) THEN _π               PField%(CurX%,CurY%) = PField%(CurX%,CurY%) + %TDOWNπ         END IFπ      END IFππ      IF ((PField%(CurX%,CurY%) AND %TLEFT) <> %TLEFT) THENπ         IF FnBlocked%(CurX%,CurY%,CurX%,CurY%-1) = %TRUE THENπ            PField%(CurX%,CurY%) = PField%(CurX%,CurY%) + %TLEFTπ         ELSEπ            IF ((PField%(CurX%,CurY%-1) AND AllTested%) = AllTested%) THEN _π               PField%(CurX%,CurY%) = PField%(CurX%,CurY%) + %TLEFTπ         END IFπ      END IFππ      IF ((PField%(CurX%,CurY%) AND %TRIGHT) <> %TRIGHT) THENπ         IF FnBlocked%(CurX%,CurY%,CurX%,CurY%+1) = %TRUE THENπ            PField%(CurX%,CurY%) = PField%(CurX%,CurY%) + %TRIGHTπ         ELSEπ            IF ((PField%(CurX%,CurY%+1) AND AllTested%) = AllTested%) THEN _π               PField%(CurX%,CurY%) = PField%(CurX%,CurY%) + %TRIGHTπ         END IFπ      END IFππ      IF ((PField%(CurX%,CurY%) AND AllTested) = AllTested) THENπ         IF ((PField%(CurX%,CurY%) AND %ORIGHT) = %ORIGHT) THENπ            INCR CurY%π            PField%(CurX%,CurY%) = PField%(CurX%,CurY%) + %TLEFTπ         ELSEπ            IF ((PField%(CurX%,CurY%) AND %OLEFT) = %OLEFT) THENπ               DECR CurY%π               PField%(CurX%,CurY%) = PField%(CurX%,CurY%) + %TRIGHTπ            ELSEπ               IF ((PField%(CurX%,CurY%) AND %OUP) = %OUP) THENπ                  DECR CurX%π                  PField%(CurX%,CurY%) = PField%(CurX%,CurY%) + %TDOWNπ               ELSEπ                  INCR CurX%π                  PField%(CurX%,CurY%) = PField%(CurX%,CurY%) + %TUPπ               END IFπ            END IFπ         END IFπ      ELSEπ         IF ((PField%(CurX%,CurY%) AND %TRIGHT) <> %TRIGHT) THENπ            INCR CurY%π            PField%(CurX%,CurY%) = PField%(CurX%,CurY%) + %TLEFT + %OLEFTπ         ELSEπ            IF ((PField%(CurX%,CurY%) AND %TLEFT) <> %TLEFT) THENπ               DECR CurY%π               PField%(CurX%,CurY%) = PField%(CurX%,CurY%) + %TRIGHT + %ORIGHTπ            ELSEπ               IF ((PField%(CurX%,CurY%) AND %TUP) <> %TUP) THENπ                  DECR CurX%π                  PField%(CurX%,CurY%) = PField%(CurX%,CurY%) + %TDOWN + %ODOWNπ               ELSEπ                  INCR CurX%π                  PField%(CurX%,CurY%) = PField%(CurX%,CurY%) + %TUP + %OUPπ               END IFπ            END IFπ         END IFπ      END IFπ      IF ((CurX% = DoorOut%) AND (CurY% = 1)) THEN NotFoundYet% = %FALSEπ   LOOP WHILE (NotFoundYet% = %TRUE)π   CALL DrawPiece(LastCurX%,LastCurY%,TokenColor%,1)π   CALL DrawPiece(CurX%,CurY%,TokenColor%,0)π   IF Cmd$ <> "DEMO" THEN SOUND 500,10πRETURNπ'=========================================== Determine if XY to XY move is OkayπDEF FnBlocked%(OldX%,OldY%,NewX%,NewY%)π   SHARED CellSize%,CellsTall%,CellsWide%π   LOCAL TestDirect%,XPoint%,YPoint%π   IF ((NewX%<1) OR (NewX%>CellsTall%) OR _π       (NewY%<1) OR (NewY%>CellsWide%)) THENπ      FnBlocked% = %TRUEπ   ELSEπ      IF OldX% = NewX% THENπ         IF OldY% > NewY% THEN TestDirect% = %LEFT ELSE TestDirect% = %RIGHTπ      ELSEπ         IF OldX% > NewX% THEN TestDirect% = %Up ELSE TestDirect% = %DOWNπ      END IFπ      Xpoint% = ((CurX% - 1) *  CellSize%) + 1π      Ypoint% = ((CurY% - 1) * (CellSize% * 2)) + 1π      SELECT CASE TestDirect%π         CASE %UP    : DECR Xpoint%                      ' Upπ         CASE %RIGHT : Ypoint%=Ypoint%+((CellSize%*2)-1) ' Rightπ         CASE %DOWN  : Xpoint%=Xpoint%+(CellSize%-1)     ' Downπ         CASE %LEFT  : DECR Ypoint%                      ' Leftπ      END SELECTπ      IF POINT(Ypoint%,Xpoint%) THEN FnBlocked% = %TRUE ELSE FnBlocked% = %FALSEπ   END IFπEND DEFπ'==================================================================== Draw MazeπDrawMaze:π   LINE (0,0) - (FrameRight%, FrameBottom%), WallColor%, Bπ   HalfWallsToDraw% = int(WallsToDraw% / 2)π   WHILE (WallsToDraw% > HalfWallsToDraw%)π      IF INKEY$>"" THEN GOSUB ExitRequestedπ      DOπ         MostX% = FnR%(CellsTall%)π         MostY% = FnR%(CellsWide%)π      LOOP WHILE (Walls%(MostX%,MostY%) = 1)π      GOSUB DrawWallπ   WENDπ   CyclicMostX% = 1π   CyclicMostY% = 1π   WHILE (WallsToDraw% > 0)π      IF INKEY$>"" THEN GOSUB ExitRequestedπ      DOπ         INCR CyclicMostY%π         IF CyclicMostY% = CellsWide% THENπ            CyclicMostY% = 1π            INCR CyclicMostX%π            IF CyclicMostX% = CellsTall% THEN CyclicMostX% = 1π         END IFπ      LOOP WHILE (Walls%(CyclicMostX%,CyclicMostY%) = 1)π      MostX% = CyclicMostX%π      MostY% = CyclicMostY%π      GOSUB DrawWallπ   WENDπRETURNπ'=========================================================== Draw players pieceπSUB DrawPiece(AtX%, AtY%, UseColor%, DroppingMark%)π   LOCAL  TopXcoord%,TopYcoord%,BotXcoord%,BotYCoord%,CenterY%,CenterX%,Rads%π   SHARED CellSize%, PColorON%, CrumbColor%π   TopXcoord% = ((AtX% - 1) *  CellSize%) + 1π   TopYcoord% = ((AtY% - 1) * (CellSize% * 2)) + 1π   BotXcoord% = (TopXcoord% + CellSize%) - 2π   BotYcoord% = (TopYcoord% + (CellSize% * 2)) - 2π   IF DroppingMark% THENπ      LINE (TopYcoord%, TopXcoord%) - (BotYcoord%, BotXcoord%), 0, BFπ      CenterY% = TopYcoord%+CellSize%π      CenterX% = TopXcoord%+FIX(CellSize%/2)π      Rads% = INT(CellSize% / 3)π      IF CellSize% = 2 THENπ         PSET (TopYcoord%+1, TopXCoord%), CrumbColor%π      ELSEπ         IF Rads% < 3 THENπ            PSET (CenterY%, CenterX%), CrumbColor%π         ELSEπ            CIRCLE (CenterY%, CenterX%), Rads%, CrumbColor%π         END IFπ      END IFπ   ELSEπ      LINE (TopYcoord%, TopXcoord%) - (BotYcoord%, BotXcoord%), UseColor%, BFπ   END IFπEND SUBπ'================================================== Print Title & Current LevelπPrintLine25:π   LOCATE 25,1π   PRINT SPACE$(79);π   LOCATE 25,1π   PRINT "MAD MAZES!  Copyright 1989 Frederick Volking  V:1.0  Level: ";π   PRINT USING "## of 10";Cycle%;πRETURNπ'==================================================================== Draw WallπDrawWall:π      FOR Which% = 1 TO 0 STEP (-1)π         Direc% = FnR%(4)π         InitMostX% = MostX%π         InitMostY% = MostY%π         WHILE (Walls%(MostX%,MostY%) = Which%)π            SELECT CASE Direc%π               CASE = 1 : DECR MostX%  'Upπ               CASE = 2 : INCR MostY%  'Rightπ               CASE = 3 : INCR MostX%  'Downπ               CASE = 4 : DECR MostY%  'Leftπ            END SELECTπ            IF ((MostX% < 0) OR (MostX% > CellsTall%) OR _π                (MostY% < 0) OR (MostY% > CellsWide%)) THENπ                IF Direc% = 4 THEN Direc% = 1 _π                   ELSE INCR Direc%π                MostX% = InitMostX%π                MostY% = InitMostY%π             END IFπ         WENDπ      NEXTπ      SELECT CASE Direc%π         CASE = 1 : LastDirec% = 3  'Upπ         CASE = 2 : LastDirec% = 4  'Rightπ         CASE = 3 : LastDirec% = 1  'Downπ         CASE = 4 : LastDirec% = 2  'Leftπ      END SELECTπ      LastX% = MostX% * CellSize%π      LastY% = (MostY% * 2) * CellSize%π      DeadEndReached% = %FALSEπ      DOπ         Cycles% = 0π         KeepLooking% = %TRUEπ         DOπ            INCR Cycles%π            NewX% = LastX%π            NewY% = LastY%π            Direc% = LastDirec%π            Turn% = (FnR%(3)-2)π            IF Turn%<>0 THENπ               Direc% = Direc% + Turn%π               IF Direc% > 4 THEN Direc% = 1π               IF Direc% < 1 THEN Direc% = 4π            END IFπ            SELECT CASE Direc%π               CASE = 1 : NewX% = LastX% -  CellSize%       'upπ               CASE = 2 : NewY% = LastY% + (CellSize% * 2)  'rightπ               CASE = 3 : NewX% = LastX% +  CellSize%       'downπ               CASE = 4 : NewY% = LastY% - (CellSize% * 2)  'leftπ            END SELECTπ            IF Cycles% < 10 THENπ               IF ((NewX% => FrameBottom%) OR (NewX% <= 0) OR _π                   (NewY% => FrameRight% ) OR (NewY% <= 0) ) THENπ                  KeepLooking% = %TRUEπ               ELSEπ                  XC% = FIX(NewX% / CellSize%)π                  YC% = FIX(NewY% / (CellSize% * 2))π                  IF Walls%(XC%,YC%) = 0 THEN KeepLooking% = %FALSE _π                     ELSE KeepLooking% = %TRUEπ               END IFπ            ELSEπ               KeepLooking% = %FALSEπ            END IFπ         LOOP WHILE (KeepLooking% = %TRUE)π         IF Cycles% < 10 THENπ            LINE (LastY%,LastX%) - (NewY%,NewX%), WallColor%π            Walls%(XC%,YC%) = 1π            DECR WallsToDraw%π            LastX% = NewX%π            LastY% = NewY%π            LastDirec% = Direc%π            DeadEndReached% = %FALSEπ         ELSEπ            DeadEndReached% = %TRUEπ         END IFπ      LOOP WHILE (DeadEndReached% = %FALSE)πRETURNπ'============================================================== Exit Requested?πExitRequested:π   LOCATE 25,1 : PRINT SPACE$(79);π   LOCATE 25,34π   PRINT "Quit? (Y/N) : ";π   DOπ      K$ = UCASE$(INKEY$)π   LOOP WHILE ((K$ <> "Y") AND (K$ <> "N") AND (K$ <> CHR$(27)))π   IF K$ = "Y" THENπ      IF MazeIsDrawn% = %TRUE THENπ         LOCATE 25,1 : PRINT SPACE$(79);π         LOCATE 25,25π         PRINT "Shall I Solve It? (Y/N) : ";π         DOπ            K$ = UCASE$(INKEY$)π         LOOP WHILE ((K$ <> "Y") AND (K$ <> "N") AND (K$ <> CHR$(27)))π         IF K$ = "N" THENπ            SCREEN 0,0π            CLSπ            ENDπ         END IFπ         IF K$ = "Y" THENπ            AutoSolve% = %TRUEπ            KeepGoing% = %FALSEπ         END IFπ      ELSEπ         SCREEN 0,0π         CLSπ         ENDπ      END IFπ   END IFπ   GOSUB PrintLine25πRETURNπ'============================= Display Total elapsed playing time for this mazeπShowElapsed:π   TimerNow! = TIMERπ   TotTime! = TimerNow! - BeginTimer!π   Minutes% = FIX(TotTime! / 60)π   Seconds% = INT(TotTime! - (Minutes% * 60))π   IF Seconds% <> LastSeconds% THENπ      LOCATE 25, 73, 0π      PRINT USING "###";Minutes%;π      PRINT ":";π      PRINT RIGHT$(STR$(Seconds%+100),2);π      LastSeconds% = Seconds%π   END IFπRETURNπ'======================================= Display Time required to complete mazeπShowTotalMazeTime:π      TimerNow! = TIMERπ      TotTime!  = TimerNow! - BeginTimer!π      Minutes%  = FIX(TotTime! / 60)π      LSeconds! = TotTime! - (Minutes% * 60)π      LOCATE 25,1 : PRINT SPACE$(79);π      LOCATE 25,1π      IF AutoSolve% = %TRUE THEN PRINT "COMPUTER's "; _π         ELSE PRINT "Your ";π      PRINT "time to complete level";Cycle%;"was: ";π      IF Minutes% > 0 THEN PRINT Minutes%; "Minute(s) ";π      PRINT USING "##.# Seconds  - Press <ANY KEY>";LSeconds!;π      IF Cmd$ <> "DEMO" THENπ         WHILE INKEY$ = "" : WENDπ      END IFπRETURNπ'====================================================== ReDefine and Set ColorsπSetUpColors:π   CLSπ   DIM DYNAMIC TempColor%(3)π   TempColor%(1) = WallColor%π   TempColor%(2) = TokenColor%π   TempColor%(3) = CrumbColor%π   FOR C% = 1 to 15π      LINE (29+(c%*32),30) - (29+(C%*32)+20,70), C%, BFπ      LOCATE 10, (c%*4)+5π      PRINT USING "##";C%;π   NEXTπ   LOCATE 14,20 : PRINT "Color for Maze Walls     : ";π   LOCATE 16,20 : PRINT "Color for Player's Token : ";π   LOCATE 18,20 : PRINT "Color for Bread Crumbs   : ";π   LOCATE 21,20 : PRINT "Press - <Up> & <Down> to Select";π   LOCATE 22,20 : PRINT "      - <Left> & <Right> to change color";π   LOCATE 2,20 : PRINT "       <ENTER> when finished";π   CurLine% = 1π   DOπ      IF CurLine% < 1 THEN CurLine% = 3π      IF CurLine% > 3 THEN CurLine% = 1π      FOR C% = 1 to 3π         IF TempColor%(C%) <  1 THEN TempColor%(C%)= 15π         IF TempColor%(C%) > 15 THEN TempColor%(C%) = 1π         LOCATE ((C% - 1) * 2) + 14, 47π         PRINT USING "##     ";TempColor%(C%);π      NEXTπ      LOCATE ((CurLine% - 1) * 2) + 14, 50π      PRINT "<--";π      DOπ         KeyChoice$ = INKEY$π      LOOP WHILE KeyChoice$ = ""π      Choice% = ASC(RIGHT$(KeyChoice$,1))π      SELECT CASE Choice%π         CASE 72 : DECR CurLine%             ' Upπ         CASE 80 : INCR CurLine%             ' Downπ         CASE 77 : INCR TempColor%(CurLine%) ' Rightπ         CASE 75 : DECR TempColor%(CurLine%) ' Leftπ         CASE 27 : GOSUB ExitRequestedπ      END SELECTπ   LOOP WHILE (KeyChoice$ <> CHR$(13))π   CLSπ   WallColor% = TempColor%(1)π   TokenColor% = TempColor%(2)π   CrumbColor% = TempColor%(3)π   ERASE TempColor%πRETURNπ'=============================================================================πDEF FnStartTimer%(Long%)π   SHARED Elapsed&,CountDown%π   IF Long% = 0 THENπ      CountDown% = %FALSEπ      Elapsed& = 0π   ELSEπ      CountDown% = %TRUEπ      Elapsed& = (CLNG(Long%)) * 997564π   END IFπ   MTIMERπEND DEFπ'=============================================================================πDEF FnSecondsElapsed%(TUR%,TUC%)π   SHARED Elapsed&,CountDown%π   LOCAL TimeSinceLast&, K%π   TimeSinceLast&=MTIMERπ   MTIMERπ   Elapsed& = Elapsed& - TimeSinceLast&π   IF Elapsed& < 0 THEN Elapsed& = 0π   K% = FnShowTime(Elapsed&)π   FnSecondsElapsed% = K%πEND DEFπ'=============================================================================πDEF FnShowTime%(HowMuch&)π   SHARED LastSecond%,CountDown%π   LOCAL Minutes%, HoldSeconds%π   HoldSeconds%=INT(FIX(HowMuch&/997564))π   Minutes%=INT(FIX(HowMuch&/59853831))π   HowMuch&=HowMuch&-(CLNG(Minutes%) * 59853831)π   Seconds%=INT(FIX(HowMuch&/997564))π   IF LastSecond%<>HoldSeconds% THENπ      LOCATE 25,73π      PRINT USING "###";Minutes%;π      PRINT ":";π      PRINT RIGHT$(STR$(Seconds%+100),2);π      LastSecond%=HoldSeconds%π   END IFπ   FnShowTime%=HoldSeconds%πEND DEFπ'=========================================================== End Of ProgrammingππThe ABC Programmer             JOYSTICK PADDLE WARS           JOYSTICK,PADDLE,WARS           Year of 1994           QB, QBasic, PDS        172  6415     PADDLE.BAS  '================================================π' JOYSTICK PADDLE WARS GAME by William Yu (1994)π'π' Requires a joystick installedπ' There's no calibration, so you may have toπ' change the joystick values to match your ownπ' or make a calibration at startup.π' The keyboard will not function properly unlessπ' you remove all occurances of STICK and STRIGπ'================================================ππDIM PAD(80), SHADOW(80), BALL(25)πCLSπSCREEN 7πV = STICK(0)πLOCATE 25, 8: COLOR 9: PRINT "Press a key to continue..."πLOCATE 1, 4: COLOR 10: PRINT "PADDLE WARS"; : COLOR 2: PRINT " VERSION 1.0"; : COLOR 13: PRINT " (C) 1994"πLOCATE 3, 8: COLOR 14: PRINT "PROGRAMMED BY WILLIAM YU"πLOCATE 5, 5: COLOR 12: PRINT CHR$(24): LOCATE 6, 3: PRINT CHR$(27); " * "; CHR$(26)πLOCATE 7, 5: PRINT CHR$(25)πCIRCLE (100, 42), 4, 12: PAINT (100, 42), 12πCIRCLE (115, 36), 4, 9: PAINT (115, 36), 9πCIRCLE (130, 42), 4, 10: PAINT (130, 42), 10πCIRCLE (115, 50), 4, 14: PAINT (115, 50), 14πLOCATE 8, 2: COLOR 11: PRINT "JOYSTICK": LOCATE 6, 20: PRINT "SHOOT"πLOCATE 10, 1: COLOR 15: PRINT "SIMPLE INSTRUCTIONS:"πLOCATE 12, 1: COLOR 7: PRINT "Red looking balls will fall from the sky"πPRINT "Your mission is to destroy those balls!"πPRINT "Easy no?"πPRINT : PRINT "To chicken out, press"; : COLOR 15: PRINT " ESC"πPRINTπCOLOR 10: PRINT "You may use your keypad, but it will go"πPRINT "slower because of the joystick"πPRINT "interference."πPRINT : COLOR 14: PRINT "Arrow keys to move, "; : COLOR 12: PRINT "ENTER"; : COLOR 14: PRINT " to shoot"πI$ = INPUT$(1)πPADDLEPLAY:πCLSπCIRCLE (160, 150), 20, 10, , , 1 / 9πPAINT (160, 150), 10πGET (134, 145)-(186, 155), PADπLINE (0, 200)-(320, 180), 11, BFπX = 135: Y = 145: Z = 185πCIRCLE (X + 25, 190), 20, 3, , , 1 / 9πPAINT (X + 24, 190), 3πGET (134, 185)-(186, 195), SHADOWπPSET (140, 190), 11πPSET (140, 150), 0πLINE (0, 20)-(1, 140), 9, BFπLINE (2, 20)-(10, 140), 11, BFπLINE (10, 20)-(10, 140), 3πLINE (8, 20)-(8, 140), 15ππRANDOMIZE TIMERπA = INT((300 - 20 + 1) * RND + 20)πE2 = INT((280 - 20 + 1) * RND + 20)πE3 = INT((280 - 20 + 1) * RND + 20)πCIRCLE (A, 20), 4, 12πPAINT (A, 20), 12πGET (A - 5, 14)-(A + 5, 24), BALLπE = A - 5: F = 14πM = 20: N = 3ππDOπ  T = STICK(0)π  S = STICK(1)π  FOR C = 1 TO 10π    IF T = C THEN GOSUB MOVELEFTπ    IF S = C THEN GOSUB UPπ  NEXT Cπ  FOR CC = V + V - 10 TO V + Vπ    IF T = CC THEN GOSUB MOVERIGHTπ    IF S = CC THEN GOSUB DOWNπ  NEXT CCπ  V$ = INKEY$π    IF V$ = CHR$(0) + "K" THEN GOSUB MOVELEFTπ    IF V$ = CHR$(0) + "M" THEN GOSUB MOVERIGHTπ    IF V$ = CHR$(0) + "H" THEN GOSUB UPπ    IF V$ = CHR$(0) + "P" THEN GOSUB DOWNπ    IF V$ = CHR$(13) THEN GOSUB SHOOTπ    IF V$ = "+" AND N < 6 THEN N = N + 1π    IF V$ = "-" AND N > 1 THEN N = N - 1π    IF STRIG(0) THEN GOSUB SHOOTπ    IF STRIG(2) THEN GOSUB SHOOTπ    IF STRIG(4) THEN GOSUB SHOOTπ    IF STRIG(6) THEN GOSUB SHOOTπ  GOSUB ENEMYπ  LOCATE 1, 1: COLOR 15: PRINT "SCORE: "; : COLOR 14: PRINT " Computer:"; : COLOR 12: PRINT EN; : COLOR 14: PRINT "You:"; : COLOR 10: PRINT PπLOOP UNTIL V$ = CHR$(27)πGOTO QUITPLAYππENEMY:πF = F + 2πIF P >= 5 THEN F2 = F2 + 1πIF P >= 25 THEN F3 = F3 + 1.5πPUT (E, F), BALL, PSETπIF P >= 5 THEN PUT (E2, F2), BALL, PSETπIF P >= 25 THEN PUT (E3, F3), BALL, PSETπIF F >= 165 THEN EN = EN + 1: PUT (E, F), BALL: F = 14: RANDOMIZE TIMER: E = INT((300 - 20 + 1) * RND + 20)πIF F2 >= 165 THEN EN = EN + 1: PUT (E2, F2), BALL: F2 = 14: RANDOMIZE TIMER: E2 = INT((280 - 20 + 1) * RND + 20)πIF F3 >= 165 THEN EN = EN + 1: PUT (E3, F3), BALL: F3 = 14: RANDOMIZE TIMER: E3 = INT((280 - 20 + 1) * RND + 20)πRETURNππMOVELEFT:πIF X <= 5 THEN RETURNπX = X - NπPUT (X, Y), PAD, PSETπPUT (X, Z), SHADOW, PSETπRETURNππMOVERIGHT:πIF X >= 262 THEN RETURNπX = X + NπPUT (X, Y), PAD, PSETπPUT (X, Z), SHADOW, PSETπRETURNππUP:πIF Y <= 145 THEN RETURNπY = Y - 2πIF Z > 180 THEN Z = Z - 1πPUT (X, Y), PAD, PSETπPUT (X, Z), SHADOW, PSETπRETURNππDOWN:πIF Y >= 168 THEN RETURNπY = Y + 2πIF Z < 189 THEN Z = Z + 1πPUT (X, Y), PAD, PSETπPUT (X, Z), SHADOW, PSETπRETURNππSHOOT:πLINE (0, M)-(10, M + 1), 0, BFπM = M + 1πIF P >= 25 THEN LINE (X + 15, Y - 5)-(X + 15, Y - 100 - P), 9πIF P >= 25 THEN LINE (X + 14, Y - 5)-(X + 14, Y - 100 - P), 11πIF P >= 25 THEN LINE (X + 39, Y - 5)-(X + 39, Y - 100 - P), 9πIF P >= 25 THEN LINE (X + 38, Y - 5)-(X + 38, Y - 100 - P), 11πLINE (X + 26, Y - 5)-(X + 26, Y - 100 - P), 11πLINE (X + 25, Y - 5)-(X + 25, Y - 100 - P), 9πFOR D = 1 TO 200: NEXT DπFOR T = 18 TO 25πIF X = E - T AND F > 40 - P THEN P = P + 1: PUT (E, F), BALL: F = 14: RANDOMIZE TIMER: E = INT((300 - 20 + 1) * RND + 20): EXIT FORπIF X = E2 - T AND F2 > 40 - P THEN P = P + 1: PUT (E2, F2), BALL: F2 = 14: RANDOMIZE TIMER: E2 = INT((280 - 20 + 1) * RND + 20): EXIT FORπIF X = E3 - T AND F3 > 40 - P THEN P = P + 1: PUT (E3, F3), BALL: F3 = 14: RANDOMIZE TIMER: E3 = INT((280 - 20 + 1) * RND + 20): EXIT FORπIF P >= 25 AND X = E - T + 15 AND F > 40 - P THEN P = P + 1: PUT (E, F), BALL: F = 14: RANDOMIZE TIMER: E = INT((300 - 20 + 1) * RND + 20): EXIT FORπIF P >= 25 AND X = E2 - T + 15 AND F2 > 40 - P THEN P = P + 1: PUT (E2, F2), BALL: F2 = 14: RANDOMIZE TIMER: E2 = INT((280 - 20 + 1) * RND + 20): EXIT FORπIF P >= 25 AND X = E3 - T + 15 AND F3 > 40 - P THEN P = P + 1: PUT (E3, F3), BALL: F3 = 14: RANDOMIZE TIMER: E3 = INT((280 - 20 + 1) * RND + 20): EXIT FORπIF P >= 25 AND X = E - T - 13 AND F > 40 - P THEN P = P + 1: PUT (E, F), BALL: F = 14: RANDOMIZE TIMER: E = INT((300 - 20 + 1) * RND + 20): EXIT FORπIF P >= 25 AND X = E2 - T - 13 AND F2 > 40 - P THEN P = P + 1: PUT (E2, F2), BALL: F2 = 14: RANDOMIZE TIMER: E2 = INT((280 - 20 + 1) * RND + 20): EXIT FORπIF P >= 25 AND X = E3 - T - 13 AND F3 > 40 - P THEN P = P + 1: PUT (E3, F3), BALL: F3 = 14: RANDOMIZE TIMER: E3 = INT((280 - 20 + 1) * RND + 20): EXIT FORπNEXT TπLINE (X + 26, Y - 5)-(X + 25, Y - 100 - P), 0, BFπIF P >= 25 THEN LINE (X + 15, Y - 5)-(X + 14, Y - 100 - P), 0, BFπIF P >= 25 THEN LINE (X + 39, Y - 5)-(X + 38, Y - 100 - P), 0, BFπIF M = 140 THEN GOTO STOPPLAYπRETURNππSTOPPLAY:πLOCATE 10, 11: COLOR 15: PRINT "ANOTHER GAME? <Y/N>"πHUH:πI$ = INPUT$(1)πIF UCASE$(I$) = "Y" THEN GOTO PADDLEPLAYπIF UCASE$(I$) = "N" THEN GOTO QUITPLAYπGOTO HUHππQUITPLAY:πLOCATE 10, 11: COLOR 15: PRINT "THANKS FOR PLAYING!!!"πSLEEP 1ππKen Sweet                      MASTERCODE                     Like Cribbage                  Unknown Date           QB, PDS                1160 37930    MCODE.BAS   DEFINT A-ZππTYPE RegTypeXπ     ax    AS INTEGERπ     bx    AS INTEGERπ     cx    AS INTEGERπ     dx    AS INTEGERπ     bp    AS INTEGERπ     si    AS INTEGERπ     di    AS INTEGERπ     flags AS INTEGERπ     ds    AS INTEGERπ     es    AS INTEGERπEND TYPEππTYPE CodeMatrixπ    Code AS STRING * 8π    Clue AS STRING * 8π    Blk AS INTEGERπ    Wht AS INTEGERπEND TYPEππDECLARE SUB InterruptX (intnum%, inreg AS RegTypeX, outreg AS RegTypeX)πDECLARE FUNCTION GetScreenMode% ()πDECLARE SUB MouseDriver (Mouse0%, Mouse1%, Mouse2%, Mouse3%)πDECLARE SUB MouseHide ()πDECLARE SUB MousePoll (Row%, Col%, LButton%, RButton%)πDECLARE SUB MouseInit ()πDECLARE SUB MouseShow ()πDECLARE SUB TitleScreen ()πDECLARE SUB Directions ()πDECLARE SUB StartUp ()πDECLARE SUB SetColors ()πDECLARE SUB CodeBar (NumPegs%)πDECLARE SUB ColorBar (NumColors%)πDECLARE SUB GameBoard (NumPegs%)πDECLARE SUB ScoreCard ()πDECLARE FUNCTION SelectCode$ (NumPegs%, NumColor%)πDECLARE SUB ShowCode (NumPegs%, Xcode$)πDECLARE SUB PegLarge (PegXloc%)πDECLARE SUB PegSmall (PegXloc%, PegYloc%)πDECLARE SUB GiveClues (Xcode$, Scode$, NumPegs%, TurnNum%)πDECLARE SUB SetClue (ClueNum%, TurnNum%, Clr%)πDECLARE SUB ComputerShow (Xcode$, NumPegs%)πDECLARE SUB ComputerMatrix (RightColors$, NumColors%, NumPegs%)πDECLARE SUB CalculateColors (NumColors%, NumPegs%, TurnNum%)πDECLARE SUB ColorWrongScan (CompRight$, CompWrong$, Xcode$, NumPegs%, TotalPeg%)πDECLARE SUB ColorRightScan (CompRight$, CompWrong$, Xcode$, NumPegs%, TotalPeg%)πDECLARE FUNCTION CalculateCode$ (NumPegs%, TurnNum%)πDECLARE SUB WordPrint (Row%, Col%, Fclr%, Bclr%, Text$)πDECLARE FUNCTION WordInput$ (Row%, Col%, Fclr%, Bclr%, HFclr%, HBclr%, TextLen%, Text$)πDECLARE FUNCTION Kbd$ ()πDECLARE SUB SetPalette (Number%, Red%, Green%, Blue%)πDECLARE SUB DrawBox (Row%, Col%, ColLen%, Fclr%, Bclr%, Format$, Style%)πDECLARE SUB Xalpha (Row%, Col%, Fclr%, Bclr%, Text$)πDECLARE SUB Xpatern (Row%, Col%, Fclr%, Bclr%, Patern$, BitNum%)πDECLARE SUB TimePause (TimeDelay%)πDECLARE FUNCTION PlayAgain% ()πDECLARE SUB GameInit ()ππDIM SHARED PlayerName$(7), PlayerScore%(7), PlayerPeg%(7), PlayerColor%(7)πDIM SHARED NumPlayer%, NumGames%, Guess(29) AS CodeMatrixπDIM SHARED PegLoop%(7), PegMatrix0%(7), PegMatrix1%(7), PegMatrix2%(7, 7)πDIM SHARED CodeMatrix$(7), PegRight%(7), PegWrong%(7, 7)ππCONST True% = -1: False% = 0ππMouseInitππMainGameStart:πON KEY(10) GOSUB ExitGameπKEY(10) ONππSCREEN 12: WIDTH 80, 30πTitleScreenπSetColorsπGameInitππStartGame:πStartUpππCLSπFOR Zloop% = 0 TO NumPlayer%π    PlayerScore%(Zloop%) = 0πNEXT Zloop%πScoreCardππIF INSTR(COMMAND$, "/DRACOS") > 0 THENπ    ON KEY(31) GOSUB GameHelpπ    KEY(31) ONπEND IFππFOR PlayGame% = 0 TO NumGames%π    FOR Player% = 0 TO NumPlayer%π        GameBoard PlayerPeg%(Player%)π        ColorBar PlayerColor%(Player%)π        SecretCode$ = SelectCode$(PlayerPeg%(Player%), PlayerColor%(Player%))π        WordPrint 2 + Player%, 24, Player% + 1, -1, ""π        CurrentColor% = 1π        IF LEFT$(UCASE$(PlayerName$(Player%)), 4) = "COMP" THENπ            FOR Zloop% = 0 TO 7π                PegRight%(Zloop%) = -1π                PegMatrix1%(Zloop%) = -1π                CodeMatrix$(Zloop%) = CHR$(255)π                FOR Xloop% = 0 TO 7π                    PegWrong%(Zloop%, Xloop%) = -1π                    PegMatrix2%(Zloop%, Xloop%) = -1π                NEXT Xloop%π            NEXT Zloop%π            ComputerCode$ = "": ComputerScan% = 0π            FOR Zloop% = 1 TO PlayerColor%(Player%)πSetComputerCode:π                Ztemp% = INT(RND * PlayerColor%(Player%)) + 1π                IF INSTR(ComputerCode$, CHR$(Ztemp%)) > 0 THEN GOTO SetComputerCodeπ                ComputerCode$ = ComputerCode$ + CHR$(Ztemp%)π            NEXT Zloop%π        END IFπ        ERASE Guessπ        FOR Turn% = 0 TO 29π            PlayerScore%(Player%) = PlayerScore%(Player%) + 1π            ScoreCardπ            CodeBar PlayerPeg%(Player%)π            WordPrint 2 + Player%, 29, Player% + 1, -1, "Guess" + STR$(Turn% + 1) + "   Round" + STR$(PlayGame% + 1)π            currentGuess$ = STRING$(8, 255)π            IF LEFT$(UCASE$(PlayerName$(Player%)), 4) = "COMP" THENπ                GOSUB ComputerTurnπ            ELSEπ                GOSUB PlayerTurnπ            END IFπ            IF Guess(Turn%).Blk = PlayerPeg%(Player%) + 1 THENπ                EXIT FORπ            ELSEIF Guess(Turn%).Blk + Guess(Turn%).Wht = PlayerPeg%(Player%) + 1 THENπ                FOR Zloop% = 0 TO Turn%π                    FOR Xloop% = 0 TO PlayerPeg%(Player%)π                        IF INSTR(SecretCode$, MID$(Guess(Zloop%).Code, Xloop% + 1, 1)) = 0 THENπ                            PegSmall Xloop%, Zloop%π                        END IFπ                    NEXT Xloop%π                NEXT Zloop%π                FOR Zloop% = 1 TO PlayerColor%(Player%)π                    IF INSTR(SecretCode$, CHR$(Zloop%)) = 0 THENπ                        PAINT (18 + (Zloop% - 1) * 27, 361), 15, 15π                    END IFπ                NEXT Zloop%π            END IFπ        NEXT Turn%π        WordPrint 2 + Player%, 24, 0, -1, SPACE$(23)π        ShowCode PlayerPeg%(Player%), SecretCode$π        BEEPπWaitButton:π        MousePoll Row%, Col%, LButton%, RButton%π        IF NOT (LButton%) AND NOT (RButton%) THEN GOTO WaitButtonπ    NEXT Player%πNEXT PlayGame%ππIF INSTR(COMMAND$, "/DRACOS") > 0 THENπ    KEY(31) OFFπEND IFππPlayDone% = PlayAgain%ππIF PlayDone% THENπ    GOTO StartGameπELSEπ    GOTO ExitGameπEND IFππππPlayerTurn:π    MouseShowπGetMouse:π    MousePoll Row%, Col%, LButton%, RButton%π    IF NOT (LButton%) AND NOT (RButton%) THEN GOTO GetMouseπ    MouseHideππIF (Col% > 6 AND Col% < 383) AND (Row% > 204 AND Row% < 252) THENπ    CurrentPeg% = INT(Col% - 7) \ 47π    IF CurrentPeg% > PlayerPeg%(Player%) THEN GOTO nextClickπ    IF LButton% THENπ        IF MID$(currentGuess$, CurrentPeg% + 1, 1) = CHR$(255) THENπ            MID$(currentGuess$, CurrentPeg% + 1, 1) = CHR$(CurrentColor%)π            CIRCLE (30 + CurrentPeg% * 47, 228), 21, CurrentColor% - 1π            PAINT (30 + CurrentPeg% * 47, 228), CurrentColor% - 1, CurrentColor% - 1π        ELSEπ            NewColor% = ASC(MID$(currentGuess$, CurrentPeg% + 1, 1)) + 1π            IF NewColor% > PlayerColor%(Player%) THEN NewColor% = 1π            MID$(currentGuess$, CurrentPeg% + 1, 1) = CHR$(NewColor%)π            CIRCLE (30 + CurrentPeg% * 47, 228), 21, NewColor% - 1π            PAINT (30 + CurrentPeg% * 47, 228), NewColor% - 1, NewColor% - 1π        END IFπ    ELSEIF RButton% THENπ        MID$(currentGuess$, CurrentPeg% + 1, 1) = CHR$(255)π        PegLarge CurrentPeg%π    END IFπELSEIF (Col% > 5 AND Col% < 383) AND (Row% > 347 AND Row% < 375) THENπ    NewColor% = INT(Col% - 6) \ 27 + 1π    IF NewColor% > PlayerColor%(Player%) THEN GOTO nextClickπ    CurrentColor% = NewColor%π    PAINT (12, 319), CurrentColor% - 1, 14πELSEIF (Col% > 136 AND Col% < 256) AND (Row% > 416 AND Row% < 464) THENπ    Done% = -1π    FOR Zloop% = 0 TO PlayerPeg%(Player%)π        IF MID$(currentGuess$, Zloop% + 1, 1) = CHR$(255) THEN Done% = 0π    NEXT Zloop%π    IF NOT (Done%) THENπ        GOTO nextClickπ    ELSEπ        GiveClues currentGuess$, SecretCode$, PlayerPeg%(Player%), Turn%π        RETURNπ    END IFπELSEIF (Col% > 507 AND Col% < 635) AND (Row% > 24 AND Row% < 475) THENπ    OldCode% = 29 - (Row% - 25) \ 15π    IF OldCode% > Turn% - 1 THENπ        GOTO nextClickπ    ELSEπ        currentGuess$ = Guess(OldCode%).Codeπ        FOR Zloop% = 0 TO PlayerPeg%(Player%)π            Ztemp% = ASC(MID$(currentGuess$, Zloop% + 1, 1))π            CIRCLE (30 + Zloop% * 47, 228), 21, Ztemp% - 1π            PAINT (30 + Zloop% * 47, 228), Ztemp% - 1, Ztemp% - 1π        NEXT Zloop%π    END IFπEND IFππnextClick:πMouseShowπTimePause 2πGOTO GetMouseπππComputerTurn:πShowCode PlayerPeg%(Player%), SecretCode$πIF LEFT$(ComputerCode$, PlayerPeg%(Player%) + 1) = LEFT$(Guess(0).Code, PlayerPeg%(Player%) + 1) THENπ    IF ComputerScan% THENπ        currentGuess$ = CalculateCode$(PlayerPeg%(Player%), Turn% - 1)π    ELSEπ        CalculateColors PlayerColor%(Player%), PlayerPeg%(Player%), Turn% - 2π        ComputerScan% = -1π        currentGuess$ = CalculateCode$(PlayerPeg%(Player%), Turn% - 1)π    END IFπELSEπ    IF Turn% = 0 THENπ        currentGuess$ = LEFT$(ComputerCode$, PlayerPeg%(Player%) + 1)π        ComputerCode$ = MID$(ComputerCode$, 2) + LEFT$(ComputerCode$, 1)π    ELSEIF Guess(Turn% - 1).Blk + Guess(Turn% - 1).Wht = PlayerPeg%(Player%) + 1 THENπ        ComputerCode$ = Guess(0).Codeπ        ComputerMatrix Guess(Turn% - 1).Code, PlayerColor%(Player%), PlayerPeg%(Player%)π        ComputerScan% = -1π        currentGuess$ = CalculateCode$(PlayerPeg%(Player%), Turn% - 1)π    ELSEIF Turn% > 2 THENπ        CalculateColors PlayerColor%(Player%), PlayerPeg%(Player%), Turn% - 2π        IF CodeMatrix$(0) = CHR$(255) THENπ            currentGuess$ = LEFT$(ComputerCode$, PlayerPeg%(Player%) + 1)π            ComputerCode$ = MID$(ComputerCode$, 2) + LEFT$(ComputerCode$, 1)π        ELSEπ            ComputerCode$ = Guess(0).Codeπ            ComputerScan% = -1π            currentGuess$ = CalculateCode$(PlayerPeg%(Player%), Turn% - 1)π        END IFπ    ELSEπ        currentGuess$ = LEFT$(ComputerCode$, PlayerPeg%(Player%) + 1)π        ComputerCode$ = MID$(ComputerCode$, 2) + LEFT$(ComputerCode$, 1)π    END IFπEND IFπ         πComputerShow currentGuess$, PlayerPeg%(Player%)πGiveClues currentGuess$, SecretCode$, PlayerPeg%(Player%), Turn%πRETURNπππGameHelp:π    ShowCode PlayerPeg%(Player%), SecretCode$π    RETURNππExitGame:π    CLS : ENDππFUNCTION CalculateCode$ (NumPegs%, TurnNum%)ππComputerRight$ = ""πFOR Zloop% = 0 TO NumPegs%π    ComputerRight$ = ComputerRight$ + CodeMatrix$(Zloop%)πNEXT Zloop%ππFOR Zloop% = 0 TO TurnNum%π    IF Guess(Zloop%).Blk > 0 AND Guess(Zloop%).Wht = 0 THENπ        FOR Xloop% = 0 TO NumPegs%π            IF INSTR(ComputerRight$, MID$(Guess(Zloop%).Code, Xloop% + 1, 1)) > 0 THENπ                FOR Yloop% = 0 TO NumPegs%π                    PegWrong%(Xloop%, Yloop%) = Yloop%π                NEXT Yloop%π                PegWrong%(Xloop%, INSTR(ComputerRight$, MID$(Guess(Zloop%).Code, Xloop% + 1, 1)) - 1) = -1π                PegRight%(Xloop%) = INSTR(ComputerRight$, MID$(Guess(Zloop%).Code, Xloop% + 1, 1)) - 1π            END IFπ        NEXT Xloop%π    ELSEIF Guess(Zloop%).Wht > 0 AND Guess(Zloop%).Blk = 0 THENπ        FOR Xloop% = 0 TO NumPegs%π            IF INSTR(ComputerRight$, MID$(Guess(Zloop%).Code, Xloop% + 1, 1)) > 0 THENπ                PegWrong%(Xloop%, INSTR(ComputerRight$, MID$(Guess(Zloop%).Code, Xloop% + 1, 1)) - 1) = INSTR(ComputerRight$, MID$(Guess(Zloop%).Code, Xloop% + 1, 1)) - 1π            END IFπ        NEXT Xloop%π    END IFπNEXT Zloop%ππFOR Zloop% = 0 TO NumPegs%π    Ztemp0% = 0: Ztemp1% = -1: Xtemp0% = 0: Xtemp1% = -1π    FOR Xloop% = 0 TO NumPegs%π        IF PegWrong%(Zloop%, Xloop%) = -1 THEN Ztemp0% = Ztemp0% + 1: Ztemp1% = Xloop%π        IF PegWrong%(Xloop%, Zloop%) = -1 THEN Xtemp0% = Xtemp0% + 1: Xtemp1% = Xloop%π    NEXT Xloop%π    IF Ztemp0% = 1 THENπ        FOR Xloop% = 0 TO NumPegs%π            PegWrong%(Zloop%, Xloop%) = Xloop%π        NEXT Xloop%π        PegRight%(Zloop%) = Ztemp1%π        PegWrong%(Zloop%, Ztemp1%) = -1π    END IFπ    IF Xtemp0% = 1 THENπ        FOR Xloop% = 0 TO NumPegs%π            PegWrong%(Xloop%, Zloop%) = Zloop%π        NEXT Xloop%π        PegRight%(Xtemp1%) = Zloop%π        PegWrong%(Xtemp1%, Zloop%) = -1π    END IFπ    IF PegRight%(Zloop%) > -1 THENπ        FOR Xloop% = 0 TO NumPegs%π            PegWrong%(Zloop%, Xloop%) = Xloop%π            PegWrong%(Xloop%, PegRight%(Zloop%)) = PegRight%(Zloop%)π        NEXT Xloop%π        PegWrong%(Zloop%, PegRight%(Zloop%)) = -1π    END IFπNEXT Zloop%ππFOR Zloop% = 0 TO NumPegs%π    IF PegRight%(Zloop%) > -1 THENπ        PegMatrix1%(Zloop%) = 0π        PegMatrix2%(Zloop%, 0) = PegRight%(Zloop%)π    ELSEπ        PegMatrix1%(Zloop%) = -1π        FOR Xloop% = 0 TO NumPegs%π            IF PegWrong%(Zloop%, Xloop%) = -1 THENπ                PegMatrix1%(Zloop%) = PegMatrix1%(Zloop%) + 1π                PegMatrix2%(Zloop%, PegMatrix1%(Zloop%)) = Xloop%π            END IFπ        NEXT Xloop%π    END IFπNEXT Zloop%ππStartPegLoop:πPegLoop%(0) = PegLoop%(0) + 1πIF PegLoop%(0) > PegMatrix1%(0) THENπ    PegLoop%(0) = 0π    PegLoop%(1) = PegLoop%(1) + 1π    IF PegLoop%(1) > PegMatrix1%(1) THENπ        PegLoop%(1) = 0π        PegLoop%(2) = PegLoop%(2) + 1π        IF PegLoop%(2) > PegMatrix1%(2) THENπ            PegLoop%(2) = 0π            IF NumPegs% = 2 THEN GOTO EndPegLoopπ            PegLoop%(3) = PegLoop%(3) + 1π            IF PegLoop%(3) > PegMatrix1%(3) THENπ                PegLoop%(3) = 0π                IF NumPegs% = 3 THEN GOTO EndPegLoopπ                PegLoop%(4) = PegLoop%(4) + 1π                IF PegLoop%(4) > PegMatrix1%(4) THENπ                    PegLoop%(4) = 0π                    IF NumPegs% = 4 THEN GOTO EndPegLoopπ                    PegLoop%(5) = PegLoop%(5) + 1π                    IF PegLoop%(5) > PegMatrix1%(5) THENπ                        PegLoop%(5) = 0π                        IF NumPegs% = 5 THEN GOTO EndPegLoopπ                        PegLoop%(6) = PegLoop%(6) + 1π                        IF PegLoop%(6) > PegMatrix1%(6) THENπ                            PegLoop%(6) = 0π                            IF NumPegs% = 6 THEN GOTO EndPegLoopπ                            PegLoop%(7) = PegLoop%(7) + 1π                            IF PegLoop%(7) > PegMatrix1%(7) THENπ                                PegLoop%(7) = 0π                            END IFπ                        END IFπ                    END IFπ                END IFπ            END IFπ        END IFπ    END IFπEND IFπEndPegLoop:ππFOR Zloop% = 0 TO NumPegs%π    PegMatrix0%(Zloop%) = PegMatrix2%(Zloop%, PegLoop%(Zloop%))πNEXT Zloop%ππDone% = -1πFOR Zloop% = 0 TO NumPegs%π    IF PegMatrix0%(Zloop%) < 0 OR PegMatrix0%(Zloop%) > NumPegs% THEN GOTO StartPegLoopπ    FOR Xloop% = 0 TO NumPegs%π        IF (Xloop% <> Zloop%) AND (PegMatrix0%(Zloop%) = PegMatrix0%(Xloop%)) THENπ            Done% = 0π            EXIT FORπ        END IFπ    NEXT Xloop%π    IF NOT (Done%) THEN EXIT FORπNEXT Zloop%ππIF NOT (Done%) THEN GOTO StartPegLoopπTestGuess$ = ""πFOR Zloop% = 0 TO NumPegs%π    TestGuess$ = TestGuess$ + CodeMatrix$(PegMatrix0%(Zloop%))πNEXT Zloop%πComputerShow TestGuess$, NumPegs%ππFOR Zloop% = TurnNum% TO 0 STEP -1π    Done% = -1: Black% = 0: White% = 0π    FOR Xloop% = 1 TO NumPegs% + 1π        IF INSTR(Guess(Zloop%).Code, MID$(TestGuess$, Xloop%, 1)) = Xloop% THEN Black% = Black% + 1π    NEXT Xloop%π    IF Black% <> Guess(Zloop%).Blk THENπ        Done% = 0π        EXIT FORπ    END IFπNEXT Zloop%ππIF NOT (Done%) THEN GOTO StartPegLoopππCalculateCode$ = TestGuess$ππEND FUNCTIONππSUB CalculateColors (NumColors%, NumPegs%, TurnNum%)ππFOR Yloop% = 0 TO NumColors%π    FOR Zloop% = 0 TO TurnNum%π        Peg0% = Guess(Zloop%).Blk + Guess(Zloop%).Wht: Peg1% = Guess(Zloop% + 1).Blk + Guess(Zloop% + 1).Whtπ        CodeNum0% = Zloop%: CodeNum1% = Zloop% + 1π        FirstPeg$ = MID$(Guess(Zloop%).Code, 1, 1): LastPeg$ = MID$(Guess(Zloop% + 1).Code, NumPegs% + 1, 1)π        GOSUB ComputerCheckπ    NEXT Zloop%πNEXT Yloop%ππIF LEN(ComputerWrong$) + 1 = NumColors% - NumPegs% THENπ    FOR Zloop% = 1 TO NumColors%π        IF INSTR(ComputerWrong$, CHR$(Zloop%)) = 0 THENπ            IF INSTR(ComputerRight$, CHR$(Zloop%)) = 0 THEN ComputerRight$ = ComputerRight$ + CHR$(Zloop%)π        END IFπ    NEXT Zloop%πELSEIF LEN(ComputerRight$) = NumPegs% + 1 THENπ    FOR Zloop% = 1 TO NumColors%π        IF INSTR(ComputerRight$, CHR$(Zloop%)) = 0 THENπ            IF INSTR(ComputerWrong$, CHR$(Zloop%)) = 0 THEN ComputerWrong$ = ComputerWrong$ + CHR$(Zloop%)π        END IFπ    NEXT Zloop%πEND IFππIF LEN(ComputerRight$) <> NumPegs% + 1 THEN EXIT SUBππComputerMatrix ComputerRight$, NumColors%, NumPegs%ππEXIT SUBππComputerCheck:πIF (NumPegs% + 1) - Peg0% = NumColors% - (NumPegs% + 1) THENπ    FOR Xloop% = 1 TO NumColors%π        IF INSTR(Guess(CodeNum0%).Code, CHR$(Xloop%)) = 0 THENπ            IF INSTR(ComputerRight$, CHR$(Xloop%)) = 0 THENπ                ComputerRight$ = ComputerRight$ + CHR$(Xloop%)π            END IFπ        END IFπ    NEXT Xloop%πEND IFπIF (NumPegs% + 1) - Peg1% = NumColors% - (NumPegs% + 1) THENπ    FOR Xloop% = 1 TO NumColors%π        IF INSTR(Guess(CodeNum1%).Code, CHR$(Xloop%)) = 0 THENπ            IF INSTR(ComputerRight$, CHR$(Xloop%)) = 0 THENπ                ComputerRight$ = ComputerRight$ + CHR$(Xloop%)π            END IFπ        END IFπ    NEXT Xloop%πEND IFππColorRightScan ComputerRight$, ComputerWrong$, Guess(CodeNum0%).Code, NumPegs%, Peg0%πColorRightScan ComputerRight$, ComputerWrong$, Guess(CodeNum1%).Code, NumPegs%, Peg1%ππColorWrongScan ComputerRight$, ComputerWrong$, Guess(CodeNum0%).Code, NumPegs%, Peg0%πColorWrongScan ComputerRight$, ComputerWrong$, Guess(CodeNum1%).Code, NumPegs%, Peg1%ππIF Peg0% < Peg1% THENπ    IF INSTR(ComputerWrong$, FirstPeg$) = 0 AND INSTR(ComputerRight$, FirstPeg$) = 0 THEN ComputerWrong$ = ComputerWrong$ + FirstPeg$π    IF INSTR(ComputerRight$, LastPeg$) = 0 AND INSTR(ComputerWrong$, LastPeg$) = 0 THEN ComputerRight$ = ComputerRight$ + LastPeg$πELSEIF Peg0% > Peg1% THENπ    IF INSTR(ComputerWrong$, LastPeg$) = 0 AND INSTR(ComputerRight$, LastPeg$) = 0 THEN ComputerWrong$ = ComputerWrong$ + LastPeg$π    IF INSTR(ComputerRight$, FirstPeg$) = 0 AND INSTR(ComputerWrong$, FirstPeg$) = 0 THEN ComputerRight$ = ComputerRight$ + FirstPeg$πELSEIF Peg0% = Peg1% THENπ    IF INSTR(ComputerRight$, FirstPeg$) > 0 AND INSTR(ComputerWrong$, LastPeg$) = 0 THENπ        IF INSTR(ComputerRight$, LastPeg$) = 0 THEN ComputerRight$ = ComputerRight$ + LastPeg$π    ELSEIF INSTR(ComputerRight$, LastPeg$) > 0 AND INSTR(ComputerWrong$, FirstPeg$) = 0 THENπ        IF INSTR(ComputerRight$, FirstPeg$) = 0 THEN ComputerRight$ = ComputerRight$ + FirstPeg$π    ELSEIF INSTR(ComputerWrong$, FirstPeg$) > 0 AND INSTR(ComputerRight$, LastPeg$) = 0 THENπ        IF INSTR(ComputerWrong$, LastPeg$) = 0 THEN ComputerWrong$ = ComputerWrong$ + LastPeg$π    ELSEIF INSTR(ComputerWrong$, LastPeg$) > 0 AND INSTR(ComputerRight$, FirstPeg$) = 0 THENπ        IF INSTR(ComputerWrong$, FirstPeg$) = 0 THEN ComputerWrong$ = ComputerWrong$ + FirstPeg$π    ELSEIF LEN(ComputerWrong$) = NumColors% - (NumPegs% + 2) THENπ        IF INSTR(ComputerRight$, FirstPeg$) = 0 AND INSTR(ComputerWrong$, FirstPeg$) = 0 THEN ComputerRight$ = ComputerRight$ + FirstPeg$π        IF INSTR(ComputerRight$, LastPeg$) = 0 AND INSTR(ComputerWrong$, LastPeg$) = 0 THEN ComputerRight$ = ComputerRight$ + LastPeg$π    ELSEIF LEN(ComputerRight$) = NumPegs% THENπ        IF INSTR(ComputerWrong$, FirstPeg$) = 0 AND INSTR(ComputerRight$, FirstPeg$) = 0 THEN ComputerWrong$ = ComputerWrong$ + FirstPeg$π        IF INSTR(ComputerWrong$, LastPeg$) = 0 AND INSTR(ComputerRight$, LastPeg$) = 0 THEN ComputerWrong$ = ComputerWrong$ + LastPeg$π    END IFπEND IFπRETURNππEND SUBππSUB CodeBar (NumPegs%)ππLINE (0, 200)-(388, 256), 14, BF: LINE (4, 204)-(384, 252), 15, BFπFOR Zloop% = 0 TO NumPegs%π    PegLarge Zloop%πNEXT Zloop%πWordPrint 12, -25, 13, -1, "ENTER CODE"ππLINE (136, 416)-(256, 464), 14, BF: LINE (140, 420)-(252, 460), 15, BFπWordPrint 28, -25, 6, -1, " TEST CODE "ππEND SUBππSUB ColorBar (NumColors%)ππLINE (0, 343)-(388, 379), 14, BF: LINE (4, 347)-(384, 375), 15, BFπLINE (0, 307)-(388, 343), 14, BF: LINE (4, 311)-(384, 339), 15, BFπLINE (8, 315)-(380, 335), 14, BF: LINE (12, 319)-(376, 331), 0, BFπFOR Zloop% = 1 TO NumColors%π    CIRCLE (18 + (Zloop% - 1) * 27, 361), 11, Zloop% - 1π    PAINT (18 + (Zloop% - 1) * 27, 361), Zloop% - 1, Zloop% - 1πNEXT Zloop%πWordPrint 19, -25, 13, -1, "COLOR BAR"π    πEND SUBππππSUB ColorRightScan (CompRight$, CompWrong$, Xcode$, NumPegs%, TotalPeg%)ππZtemp% = 0πFOR Xloop% = 1 TO NumPegs% + 1π    IF INSTR(CompRight$, MID$(Xcode$, Xloop%, 1)) > 0 THEN Ztemp% = Ztemp% + 1πNEXT Xloop%πIF Ztemp% = TotalPeg% THENπ    FOR Xloop% = 1 TO NumPegs% + 1π        IF INSTR(CompRight$, MID$(Xcode$, Xloop%, 1)) = 0 THENπ            IF INSTR(CompWrong$, MID$(Xcode$, Xloop%, 1)) = 0 THENπ                CompWrong$ = CompWrong$ + MID$(Xcode$, Xloop%, 1)π            END IFπ        END IFπ    NEXT Xloop%πEND IFππEND SUBππSUB ColorWrongScan (CompRight$, CompWrong$, Xcode$, NumPegs%, TotalPeg%)ππZtemp% = 0πFOR Xloop% = 1 TO NumPegs% + 1π    IF INSTR(CompWrong$, MID$(Xcode$, Xloop%, 1)) > 0 THEN Ztemp% = Ztemp% + 1πNEXT Xloop%πIF Ztemp% = (NumPegs% + 1) - TotalPeg% THENπ    FOR Xloop% = 1 TO NumPegs% + 1π        IF INSTR(CompWrong$, MID$(Xcode$, Xloop%, 1)) = 0 THENπ            IF INSTR(CompRight$, MID$(Xcode$, Xloop%, 1)) = 0 THENπ                CompRight$ = CompRight$ + MID$(Xcode$, Xloop%, 1)π            END IFπ        END IFπ    NEXT Xloop%πEND IFππEND SUBππSUB ComputerMatrix (RightColors$, NumColors%, NumPegs%)ππZtemp% = 0πFOR Zloop% = 1 TO NumColors%π    IF INSTR(RightColors$, CHR$(Zloop%)) > 0 THENπ        CodeMatrix$(Ztemp%) = CHR$(Zloop%)π        PegLoop%(Ztemp%) = NumPegs% - Ztemp%π        Ztemp% = Ztemp% + 1π    END IFπNEXT Zloop%πPegLoop%(0) = NumPegs% - 1ππEND SUBππSUB ComputerShow (Xcode$, NumPegs%)ππFOR Zloop% = 0 TO NumPegs%π    NewColor% = ASC(MID$(Xcode$, Zloop% + 1, 1))π    CIRCLE (30 + Zloop% * 47, 228), 21, NewColor% - 1π    PAINT (30 + Zloop% * 47, 228), NewColor% - 1, NewColor% - 1πNEXT Zloop%ππEND SUBππSUB DrawBox (Row%, Col%, ColLen%, Fclr%, Bclr%, Format$, Style%)ππSELECT CASE Style%π    CASE 0: Box0$ = "┌": Box1$ = "─": Box2$ = "┐": Box3$ = "│": Box4$ = "├": Box5$ = "┤": Box6$ = "└": Box7$ = "┘"π    CASE 1: Box0$ = "╔": Box1$ = "═": Box2$ = "╗": Box3$ = "║": Box4$ = "╠": Box5$ = "╣": Box6$ = "╚": Box7$ = "╝"π    CASE 2: Box0$ = "╓": Box1$ = "─": Box2$ = "╖": Box3$ = "║": Box4$ = "╟": Box5$ = "╢": Box6$ = "╙": Box7$ = "╜"π    CASE 3: Box0$ = "╒": Box1$ = "═": Box2$ = "╕": Box3$ = "│": Box4$ = "╞": Box5$ = "╡": Box6$ = "╘": Box7$ = "╛"πEND SELECTππIF Bclr% >= 0 THENπ    COLOR Fclr%, Bclr%πELSEπ    COLOR Fclr%πEND IFππFOR Zloop% = 0 TO LEN(Format$) - 1π    LOCATE Row% + Zloop%, Col%π    BoxTemp$ = MID$(Format$, Zloop% + 1, 1)π    SELECT CASE UCASE$(BoxTemp$)π        CASE "T":  PRINT Box0$ + STRING$(ColLen%, Box1$) + Box2$;π        CASE "M":  PRINT Box4$ + STRING$(ColLen%, Box1$) + Box5$;π        CASE "S":  PRINT Box3$ + SPACE$(ColLen%) + Box3$;π        CASE "B":  PRINT Box6$ + STRING$(ColLen%, Box1$) + Box7$;π    END SELECTπNEXT Zloop%ππEND SUBππSUB GameBoard (NumPegs%)ππLINE (503, 0)-(639, 479), 14, BF: LINE (399, 0)-(506, 479), 14, BFπLINE (507, 4)-(635, 475), 15, BF: LINE (403, 4)-(501, 475), 15, BFπFOR Xloop% = 0 TO NumPegs%π    FOR Zloop% = 0 TO 29π        PegSmall Xloop%, Zloop%π        CIRCLE (494 - Xloop% * 12, 467 - Zloop% * 15), 3, 14π        CIRCLE (494 - Xloop% * 12, 467 - Zloop% * 15), 2, 14π        LINE (399, 460 - Zloop% * 15)-(639, 460 - Zloop% * 15), 14π    NEXT Zloop%π    CIRCLE (518 + Xloop% * 15, 15), 5, 14π    PAINT (518 + Xloop% * 15, 15), 14, 14π    CIRCLE (518 + Xloop% * 15, 15), 3, 15π    LINE (518 + Xloop% * 15, 15)-(518 + Xloop% * 15, 467), 14πNEXT Xloop%ππEND SUBππSUB GameInitππFOR Zloop% = 0 TO 7π    PlayerName$(Zloop%) = "PLAYER  #" + LTRIM$(STR$(Zloop% + 1))πNEXT Zloop%ππEND SUBππFUNCTION GetScreenMode%ππ    TempMode% = True%π    π    ON LOCAL ERROR GOTO GetScreenModeErrorπ        COLOR , 0ππ    GetScreenMode% = TempMode%ππ    EXIT FUNCTIONππGetScreenModeError:π    TempMode% = False%π    RESUME NEXTππEND FUNCTIONππSUB GiveClues (Xcode$, Scode$, NumPegs%, TurnNum%)ππCurrentClue% = 0: CurrentClue$ = STRING$(8, 255): CurrentCode$ = STRING$(8, 255)πGuess(TurnNum%).Code = Xcode$: Guess(TurnNum%).Clue = STRING$(8, 0)πFOR Zloop% = 0 TO NumPegs%π    Ztemp% = ASC(MID$(Xcode$, Zloop% + 1, 1))π    CIRCLE (518 + Zloop% * 15, 467 - TurnNum% * 15), 5, Ztemp% - 1π    PAINT (518 + Zloop% * 15, 467 - TurnNum% * 15), Ztemp% - 1, Ztemp% - 1π    IF MID$(Scode$, Zloop% + 1, 1) = MID$(Xcode$, Zloop% + 1, 1) THENπ        MID$(Guess(TurnNum%).Clue, CurrentClue% + 1, 1) = CHR$(1)π        MID$(CurrentClue$, Zloop% + 1, 1) = CHR$(1)π        MID$(CurrentCode$, Zloop% + 1, 1) = CHR$(1)π        SetClue CurrentClue%, TurnNum%, 0π        CurrentClue% = CurrentClue% + 1π        Guess(TurnNum%).Blk = Guess(TurnNum%).Blk + 1π    END IFπNEXT Zloop%πFOR Zloop% = 0 TO NumPegs%π    FOR Xloop% = 0 TO NumPegs%π        IF MID$(CurrentClue$, Xloop% + 1, 1) < CHR$(255) OR MID$(CurrentCode$, Zloop% + 1, 1) < CHR$(255) THENπ            GOTO NextPegπ        ELSEIF MID$(Scode$, Xloop% + 1, 1) = MID$(Xcode$, Zloop% + 1, 1) THENπ            MID$(Guess(TurnNum%).Clue, CurrentClue% + 1, 1) = CHR$(2)π            MID$(CurrentClue$, Xloop% + 1, 1) = CHR$(2)π            MID$(CurrentCode$, Zloop% + 1, 1) = CHR$(2)π            SetClue CurrentClue%, TurnNum%, 1π            CurrentClue% = CurrentClue% + 1π            Guess(TurnNum%).Wht = Guess(TurnNum%).Wht + 1π        END IFπNextPeg:π    NEXT Xloop%πNEXT Zloop%ππEND SUBππFUNCTION Kbd$ππKey$ = ""πWHILE Key$ = ""π    Key$ = INKEY$πWENDππKbd$ = Key$ππEND FUNCTIONππSUB MouseDriver (Mouse0%, Mouse1%, Mouse2%, Mouse3%) STATICππ    DIM Registers AS RegTypeXππ    IF NOT (MouseChecked%) THENπ        DEF SEG = 0π        MouseSegment& = 256& * PEEK(207) + PEEK(206)π        MouseOffset& = 256& * PEEK(205) + PEEK(204)π        DEF SEG = MouseSegment&π        IF (MouseSegment& = 0 AND MouseOffset& = 0) OR PEEK(MouseOffset&) = 207 THENπ            MousePresent% = False%: MouseChecked% = True%π            DEF SEGπ        END IFπ    END IFππ    IF NOT (MousePresent%) AND MouseChecked% THENπ        Mouse0% = False%π        EXIT SUBπ    END IFπ    π    Registers.ax = Mouse0%: Registers.bx = Mouse1%: Registers.cx = Mouse2%: Registers.dx = Mouse3%π    InterruptX 51, Registers, Registersππ    Mouse0% = Registers.ax: Mouse1% = Registers.bx: Mouse2% = Registers.cx: Mouse3% = Registers.dxππ    IF MouseChecked% THEN EXIT SUBππ    IF Mouse0% AND NOT MouseChecked% THENπ        MousePresent% = True%π        Mouse0% = True%π        DEF SEGπ    END IFπ    MouseChecked% = True%π    πEND SUBππSUB MouseHideππ   MouseDriver 2, 0, 0, 0ππEND SUBππSUB MouseInitππ    MouseDriver 0, 0, 0, 0π    πEND SUBππSUB MousePoll (Row%, Col%, LButton%, RButton%)ππ    ScreenMode% = GetScreenMode%ππ    MouseDriver 3, Button%, Col%, Row%ππ    IF ScreenMode% THENπ        Row% = Row% / 8 + 1: Col% = Col% / 8 + 1π    END IFπ                                                π    IF Button% AND 1 THENπ        LButton% = True%π    ELSEπ        LButton% = False%π    END IFππ    IF Button% AND 2 THENπ        RButton% = True%π    ELSEπ        RButton% = False%π    END IFππEND SUBππSUB MouseShowππ    MouseDriver 1, 0, 0, 0ππEND SUBππSUB PegLarge (PegXloc%)π       πCIRCLE (30 + PegXloc% * 47, 228), 21, 14πPAINT (30 + PegXloc% * 47, 228), 14, 14πCIRCLE (30 + PegXloc% * 47, 228), 17, 15πCIRCLE (30 + PegXloc% * 47, 228), 16, 15πCIRCLE (30 + PegXloc% * 47, 228), 15, 15ππEND SUBππSUB PegSmall (PegXloc%, PegYloc%)π       πCIRCLE (518 + PegXloc% * 15, 467 - PegYloc% * 15), 5, 14πPAINT (518 + PegXloc% * 15, 467 - PegYloc% * 15), 14, 14πCIRCLE (518 + PegXloc% * 15, 467 - PegYloc% * 15), 3, 15ππEND SUBππFUNCTION PlayAgain%ππCodeBar -1πColorBar 0πGameBoard -1ππClr% = 0: Peg% = 1πFOR Zloop% = 1 TO 2π    CIRCLE (30 + Peg% * 47, 228), 21, Clr%π    PAINT (30 + Peg% * 47, 228), Clr%, Clr%π    Clr% = 1: Peg% = 6πNEXT Zloop%ππWordPrint 18, -25, 6, -1, "PLAY AGAIN                    EXIT GAME"πTimePause 2πMouseShowπPlayAgainPress:πMousePoll Row%, Col%, LButton%, RButton%ππIF (Col% > 6 AND Col% < 383) AND (Row% > 204 AND Row% < 252) THENπ    IF LButton% THENπ        MouseHideπ        TestPoint% = POINT(Col% + 1, Row% + 1)π        MouseShowπ        IF TestPoint% = 0 THENπ            PlayAgain% = -1π        ELSEIF TestPoint% = 1 THENπ            PlayAgain% = 0π        ELSEπ            GOTO PlayAgainPressπ        END IFπ    ELSEπ        GOTO PlayAgainPressπ    END IFπELSEπ    GOTO PlayAgainPressπEND IFππMouseHideππEND FUNCTIONππSUB ScoreCardππDrawBox 1, 1, 20, 15, -1, "TS" + STRING$(NumPlayer%, "S") + "B", 1πFOR Zloop% = 0 TO NumPlayer%π    Ztemp$ = RIGHT$("000" + RIGHT$(STR$(PlayerScore%(Zloop%)), LEN(STR$(PlayerScore%(Zloop%))) - 1), 3)π    WordPrint 2 + Zloop%, 3, 1 + Zloop%, -1, PlayerName$(Zloop%) + SPACE$(15 - LEN(PlayerName$(Zloop%))) + Ztemp$πNEXT Zloop%ππEND SUBππFUNCTION SelectCode$ (NumPegs%, NumColor%)ππRANDOMIZE (TIMER)ππCodeColor$ = STRING$(14, 1)ππFOR Zloop% = 0 TO NumPegs%πNewColor:π    Ztemp% = INT(RND * NumColor%) + 1π    IF MID$(CodeColor$, Ztemp%, 1) = CHR$(255) THEN GOTO NewColorπ    TempCode$ = TempCode$ + CHR$(Ztemp%)π    MID$(CodeColor$, Ztemp%, 1) = CHR$(255)πNEXT Zloop%ππSelectCode$ = TempCode$ππEND FUNCTIONππSUB SetClue (ClueNum%, TurnNum%, Clr%)ππCIRCLE (494 - ClueNum% * 12, 467 - TurnNum% * 15), 3, Clr%πPAINT (494 - ClueNum% * 12, 467 - TurnNum% * 15), Clr%, Clr%ππEND SUBππSUB SetColorsππCLSπSetPalette 0, 0, 0, 0      ' BLACKπSetPalette 1, 55, 55, 55   ' WHITEπSetPalette 2, 25, 25, 25   ' GRAYπSetPalette 3, 45, 0, 0     ' REDπSetPalette 4, 0, 45, 0     ' GREENπSetPalette 5, 0, 0, 45     ' BLUEπSetPalette 6, 53, 53, 0    ' YELLOWπSetPalette 7, 40, 0, 40    ' PURPLEπSetPalette 8, 60, 30, 0    ' ORANGEπSetPalette 9, 0, 40, 40   ' CYANπSetPalette 10, 63, 31, 31  ' PEACHπSetPalette 11, 44, 0, 24   ' ROSEπSetPalette 12, 0, 20, 5    ' GRASSπSetPalette 13, 0, 20, 60   ' SKYπSetPalette 14, 18, 9, 0    ' BROWN 2πSetPalette 15, 32, 16, 0   ' BROWN 1ππEND SUBππSUB SetPalette (Number%, Red%, Green%, Blue%)ππ    PALETTE Number%, 65536 * Blue% + 256 * Green% + Red%ππEND SUBππSUB ShowCode (NumPegs%, Xcode$)ππFOR Zloop% = 0 TO NumPegs%π    Ztemp% = ASC(MID$(Xcode$, Zloop% + 1, 1))π    CIRCLE (518 + Zloop% * 15, 15), 5, Ztemp% - 1π    PAINT (518 + Zloop% * 15, 15), Ztemp% - 1, Ztemp% - 1πNEXT Zloop%ππEND SUBππSUB StartUpππCLSππXalpha 20, 1, 13, -1, "MASTERCODE"ππWordPrint 2, -41, 4, -1, "╔════════════════════════════╗"πWordPrint 3, -41, 4, -1, "║                            ║"πWordPrint 4, -41, 4, -1, "╚════════════════════════════╝"πWordPrint 3, -41, 12, -1, "NUMBER OF PLAYERS  (1-8)  "ππSloop.01:π    NumPlayer% = VAL(WordInput$(3, 53, 11, -1, 11, -1, 1, "1")) - 1π    IF NumPlayer% < 0 OR NumPlayer% > 7 THEN GOTO Sloop.01ππWordPrint 5, -41, 4, -1, "╔════════════════════════════╗"πFOR Zloop% = 0 TO NumPlayer%π    WordPrint 6 + Zloop%, -41, 4, -1, "║                            ║"πNEXT Zloop%πWordPrint 7 + NumPlayer%, -41, 4, -1, "╚════════════════════════════╝"ππFOR Zloop% = 0 TO NumPlayer%π    WordPrint 6 + Zloop%, 28, 12, -1, "PLAYER  #" + RIGHT$(STR$(Zloop% + 1), 1)π    PlayerName$(Zloop%) = WordInput$(6 + Zloop%, 40, 11, -1, 12, -1, 14, PlayerName$(Zloop%))πNEXT Zloop%ππWordPrint 8 + NumPlayer%, -41, 4, -1, "╔═══════              ═══════╗"πFOR Zloop% = 0 TO 1π    WordPrint 9 + Zloop% + NumPlayer%, -41, 4, -1, "║                            ║"πNEXT Zloop%πWordPrint 11 + NumPlayer%, -41, 4, -1, "╚════════════════════════════╝"ππFOR Zloop% = 0 TO NumPlayer%π    WordPrint 8 + NumPlayer%, -41, 0, -1, SPACE$(14)π    WordPrint 8 + NumPlayer%, -41, 9, -1, PlayerName$(Zloop%)π    WordPrint 9 + NumPlayer%, 28, 12, -1, "TOTAL PEGS IN CODE (3-8)"π    WordPrint 10 + NumPlayer%, -41, 0, -1, SPACE$(26)πSLOOP.02:π    PlayerPeg%(Zloop%) = VAL(WordInput$(9 + NumPlayer%, 53, 11, -1, 11, -1, 1, "3")) - 1π    IF PlayerPeg%(Zloop%) < 2 OR PlayerPeg%(Zloop%) > 7 THEN GOTO SLOOP.02π    LowDif$ = CHR$(PlayerPeg%(Zloop%) + 50)π    WordPrint 10 + NumPlayer%, 30, 12, -1, "TOTAL COLORS (" + LowDif$ + "-14)"πSLOOP.03:π    PlayerColor%(Zloop%) = VAL(WordInput$(10 + NumPlayer%, 50, 11, -1, 11, -1, 2, LowDif$))π    IF PlayerColor%(Zloop%) < VAL(LowDif$) OR PlayerColor%(Zloop%) > 14 THEN GOTO SLOOP.03πNEXT Zloop%ππWordPrint 8 + NumPlayer%, -41, 4, -1, "╔════════════════════════════╗"πFOR Zloop% = 0 TO 1π    WordPrint 9 + NumPlayer%, -41, 4, -1, "║                            ║"πNEXT Zloop%πWordPrint 11 + NumPlayer%, -41, 4, -1, "╚════════════════════════════╝"πWordPrint 9 + NumPlayer%, -41, 12, -1, "NUMBER OF ROUNDS TO PLAY"πWordPrint 10 + NumPlayer%, -41, 12, -1, " TOTAL ROUNDS (1-9) # "πSLOOP.04:πNumGames% = VAL(WordInput$(10 + NumPlayer%, 50, 11, -1, 11, -1, 1, "1")) - 1πIF NumGames% < 0 OR NumGames% > 8 THEN GOTO SLOOP.04ππEND SUBππSUB TimePause (TimeDelay%)ππStartTime& = TIMER * 100 + TimeDelay% * 10ππDOπLOOP UNTIL (TIMER * 100) > StartTime&ππEND SUBππSUB TitleScreenππSetPalette 1, 0, 0, 0: SetPalette 2, 0, 0, 0: SetPalette 3, 0, 0, 0πXalpha 2, 1, 1, -1, "MASTERCODE"πGOSUB TitleExitπXalpha 13, 32, 2, -1, "BY"πGOSUB TitleExitπXalpha 23, 5, 3, -1, "KEN SWEET"πGOSUB TitleExitπFOR Zloop% = 0 TO 63π    SetPalette 1, Zloop%, 0, 0: SetPalette 2, 0, Zloop%, 0: SetPalette 3, 0, 0, Zloop%π    GOSUB TitleExitπNEXT Zloop%πFOR Zloop% = 0 TO 63π    SetPalette 1, 63 - Zloop%, Zloop%, 0: SetPalette 2, 0, 63 - Zloop%, Zloop%: SetPalette 3, Zloop%, 0, 63 - Zloop%π    GOSUB TitleExitπNEXT Zloop%πFOR Zloop% = 0 TO 63π    SetPalette 1, 0, 63 - Zloop%, Zloop%: SetPalette 2, Zloop%, 0, 63 - Zloop%: SetPalette 3, 63 - Zloop%, Zloop%, 0π    GOSUB TitleExitπNEXT Zloop%πFOR Zloop% = 0 TO 63π    SetPalette 1, Zloop%, 0, 63 - Zloop%: SetPalette 2, 63 - Zloop%, Zloop%, 0: SetPalette 3, 0, 63 - Zloop%, Zloop%π    GOSUB TitleExitπNEXT Zloop%ππEXIT SUBππTitleExit:πIF INKEY$ <> "" THEN EXIT SUBπRETURNππEND SUBππFUNCTION WordInput$ (Row%, Col%, Fclr%, Bclr%, HFclr%, HBclr%, TextLen%, Text$)ππText$ = LEFT$(Text$ + SPACE$(TextLen%), TextLen%)πTempText$ = Text$: Done% = 0: TextPos% = 1ππDO WHILE NOT (Done%)π    LOCATE Row%, Col%π    IF Bclr% >= 0 THENπ        COLOR Fclr%, Bclr%π    ELSEπ        COLOR Fclr%π    END IFπ    PRINT LEFT$(RTRIM$(TempText$) + STRING$(TextLen%, "_"), TextLen%);π  π    LOCATE Row%, Col% + TextPos% - 1π    IF HBclr% >= 0 THENπ        COLOR HFclr%, HBclr%π    ELSEπ        COLOR HFclr%π    END IFπ    PRINT MID$(TempText$, TextPos%, 1);ππ    WKey$ = Kbd$ππ    SELECT CASE WKey$π        CASE CHR$(27): TempText$ = "": GOTO ENDINPUTπ        CASE CHR$(0) + "G": TextPos% = 1π        CASE CHR$(0) + "O": TextPos% = TextLen%π        CASE CHR$(0) + "S": TempText$ = LEFT$(TempText$, TextPos% - 1) + MID$(TempText$, TextPos% + 1) + " "π        CASE CHR$(13): Done% = -1π        CASE CHR$(0) + "K": TextPos% = TextPos% - 1: IF TextPos% < 1 THEN TextPos% = 1π        CASE CHR$(0) + "M": TextPos% = TextPos% + 1: IF TextPos% > TextLen% THEN TextPos% = TextLen%π        CASE CHR$(0) + "R": TempText$ = LEFT$(LEFT$(TempText$, TextPos% - 1) + " " + MID$(TempText$, TextPos%), TextLen%)π        CASE CHR$(8)π            IF TextPos% > 1 THENπ                TempText$ = LEFT$(TempText$, TextPos% - 2) + MID$(TempText$, TextPos%) + " "π                TextPos% = TextPos% - 1π            ELSEπ                TempText$ = MID$(TempText$, 2) + " "π            END IFπ        CASE " " TO "~"π            MID$(TempText$, TextPos%, 1) = WKey$: TextPos% = TextPos% + 1π            IF TextPos% > TextLen% THEN TextPos% = TextLen%π    END SELECTπLOOPππENDINPUT:ππLOCATE Row%, Col%πIF Bclr% >= 0 THENπ    COLOR Fclr%, Bclr%πELSEπ    COLOR Fclr%πEND IFπPRINT LEFT$(RTRIM$(TempText$) + SPACE$(TextLen%), TextLen%);πWordInput$ = RTRIM$(TempText$)ππEND FUNCTIONππSUB WordPrint (Row%, Col%, Fclr%, Bclr%, Text$)ππIF Col% >= 1 THENπ    LOCATE Row%, Col%πELSEπ    LOCATE Row%, ABS(Col%) - LEN(Text$) / 2πEND IFππIF Bclr% >= 0 THENπ    COLOR Fclr%, Bclr%πELSEπ    COLOR Fclr%πEND IFππPRINT Text$;ππEND SUBππSUB Xalpha (Row%, Col%, Fclr%, Bclr%, Text$)ππFOR Zloop% = 1 TO LEN(Text$)π    ColTemp% = Col% + (Zloop% - 1) * 8πSELECT CASE UCASE$(MID$(Text$, Zloop%, 1))π    CASE " ": Xchr$ = "00000000000000"π    CASE "A": Xchr$ = "081422227F4141"π    CASE "B": Xchr$ = "7E41417E41417E"π    CASE "C": Xchr$ = "3E41404040413E"π    CASE "D": Xchr$ = "7E41414141417E"π    CASE "E": Xchr$ = "7F40407E40407F"π    CASE "K": Xchr$ = "41424478444241"π    CASE "M": Xchr$ = "41635549414141"π    CASE "N": Xchr$ = "41615149454341"π    CASE "O": Xchr$ = "3E41414141413E"π    CASE "R": Xchr$ = "7E41417E444241"π    CASE "S": Xchr$ = "3E41403E01413E"π    CASE "T": Xchr$ = "7F080808080808"π    CASE "W": Xchr$ = "41414149556341"π    CASE "Y": Xchr$ = "4141413E080808"πEND SELECTππXpatern Row%, ColTemp%, Fclr%, Bclr%, Xchr$, 6ππNEXT Zloop%ππEND SUBππSUB Xpatern (Row%, Col%, Fclr%, Bclr%, Patern$, BitNum%)ππIF Bclr% >= 0 THENπ    COLOR Fclr%, Bclr%πELSEπ    COLOR Fclr%πEND IFππFOR Zloop0% = 1 TO LEN(Patern$) STEP 2π    LOCATE Row% + INT(Zloop0% / 2), Col%π    Pvalue% = VAL("&H" + MID$(Patern$, Zloop0%, 2))π    IF Pvalue% = 0 THENπ        PRINT SPACE$(BitNum% + 1);π    ELSEπ        FOR Zloop1% = BitNum% TO 0 STEP -1π            IF (Pvalue% AND 2 ^ Zloop1%) = 2 ^ Zloop1% THEN PRINT "█";  ELSE PRINT " ";π        NEXT Zloop1%π    END IFπNEXT Zloop0%ππEND SUBππCalvin French/Victor Yiu       FAST SPRITE ROUTINE            FidoNet QUIK_BAS Echo          Year of 1993           ASM, QB, PDS           166  5812     SPRITES.BAS ' Here is the self-extracting script that makes a QuickBasic/PDS callableπ' OBJect file containing Sprite manipulation code in assembly.π' More information (source) on next page...π'π'>>> Page 1 of SPRITE.OBJ begins here. TYPE:BINAA TLEN:142πDEFINT A-Z:DIM SHARED K,S,B&,Z&:V1 'Created by PostIt! 7.1πSUB V1:OPEN "O",1,"SPRITE.OBJ",4^6:Z&=142:?STRING$(50,177);πU"&O-%+%xuwnIyjje%3%%)%htij%+uzg#qnhGAg,%/%n%'(4&+_5%%%&.%uzyx%uwπU"ny%j%%%)Uor%%&%%zGZeC%5&>E/K1%o]*9Zk3]4e&p3\ZM5O&#Z%(+Zs-kXDXvcπU"u%/9eC6y[WqXRPB>e&X0hoC.6dd_lu[$df2_.-D,,C1%*AY'%(%CπEND SUBπCLOSE:IF S=158AND B&=Z&THEN?" :) Ok!"ELSE?" :( Bad!πSUB U(A$):FOR A=1TO LEN(A$):C=ASC(MID$(A$,A))-37:IF C<0THEN C=91+C*32πIF K<4THEN K=C+243ELSE?#1,CHR$(C+(K MOD 3)*86);:K=K\3:B&=B&+1πS=(S+C)AND 255:NEXT:LOCATE,1:?STRING$(B&*50\Z&,219);:END SUBπ'>>> Page 1 of SPRITE.OBJ ends here. Last page. TCHK:158πππ'Here's the rewritten code that does exactly yours should do.π'I've included a sample program (posted after this message) to demonstateπ'its capabilities (and what it should do).  BTW, it is FAST.  (At leastπ'fast enough on a 286 to be acceptable.)  It is on par with games fromπ'Apogee (DUKE Nukem, Cosmo's Adventure's...)!ππ'BTW -- it is twice as fast as PUT (XOR/OR), but half the speed as PUTπ'(PSET).ππ'Performance on 100x100x256 sprites:π'    10MHz 8088:   7 updates per second     <--- pretty acceptable, consideringπ'   34MHz 80486: 150 updates per second          what it is...ππ;=================================================================π; SimpleSprite v1.1 (SSPRITE.ASM) A simple sprite routineπ; in asm to overlay GET format images.π;π; Calvin French, 1993  Victor Yiu, 2,348 B.C.π; Released into the Public Domainπ;π; NOTE: This routine handles sprites of all sizes *****π;π; DECLARE SUB PutSprite (BYVAL x%, BYVAL y%, BYVAL imgseg%, BYVALimgoff%,_π;       BYVAL imgWid%, BYVAL imgHei%)ππCODE SEGMENT PARA 'PUBLIC'π    PUBLIC PutSpriteπ    ASSUME CS:CODE, DS:nothing, ES:nothing, SS:nothingππBytesPerLine    EQU   320       ; ****** CHANGE to other number is neededπ                                ; defaults to 320, for 320x200x256 res.πPutSprite PROC FARπ        PUSH BP         π        MOV BP, SP      ;set up stack frameπ        PUSH DSπ        PUSH SIπ        PUSH DI         ; save BASIC's needed registersππ        LDS SI, WORD PTR SS:[BP+10] ; very fast segment/offset loadingπ                                    ; using LES/DSπ        MOV AX, 0A000hπ        MOV ES, AX          ; set up vid. mem. addr.ππ        MOV AX, SS:[BP+14]  ; get Y addressπ        MOV BX, 320         ; *320π        MUL BXπ        MOV DI, SS:[BP+16]  ; put X in SIπ        ADD DI, AX          ; add rest -- result in SIππ        MOV DX, SS:[BP+6]   ; put height in DXπ        MOV CX, SS:[BP+8]   ; put width in CXπ        MOV BX, CX          ; save it in BX (width)π        MOV BP, DI          ; save screen pointer to BPππ        CLD                 ; look into the futureππ    ; ============== main stuff startsπEVENπNewPixel:π        LODSB               ; get byte [DS:SI] -> ALπ        OR AL, AL           ; set flagsπ        JZ Skip             ; if zero (lesser common case), then jumpπ                            ; Jumping eats processor time and is BAD.π        STOSB               ; if not, write byteπ        LOOP NewPixel       ; next loopπEVENπEndOfLine:                  ; fell out of loop (end of line)π        MOV CX, BX          ; reset count for next loopπ        ADD BP, BytesPerLine; increment next screen lineπ        MOV DI, BP          ; place offset into DIπ        DEC DX              ; reduce heightπ        JZ OttaHere         ; finished?  YES!π        JMP SHORT NewPixel  ; nope -- continue...πEVENπSkip:                       ; goes here to skip pixelπ        INC DI              ; skip byte (don't do anything)π        LOOP NewPixel       ; next pix.π        JMP SHORT EndOfLine ; if end of loop, jump to handlerππ    ; ============== closing procedureπEVEN πOttaHere:π        POP DI              ; restore registersπ        POP SIπ        POP DSπ        POP BPπ        RET 12              ; and remove 12 bytes of passed params.πPutSprite ENDP              ; from stackπ    CODE ENDSπENDππππ'Here's the DEMOnstration program I made to show how FAST it is.π'BTW -- the asm., although acceptably fast, used jumps and no-in-lineπ'code. I don't know another way of doing it...  Good news is .. IT WORKS!ππ'Here it goes:π' ========================πDEFINT A-ZππDECLARE SUB PutSprite (BYVAL x%, BYVAL y%, BYVAL imgseg%, BYVAL imgoff%, BYVAL imgWid%, BYVAL imgHei%)πDIM ScreenCut%(5102)      '100x100x256πDIM ScreenCut2%(5102)ππSCREEN 13ππCLSπRANDOMIZE TIMERπFOR Z = 1 TO 50 STEP 3          ' make demo image to pasteπ    CIRCLE (50, 50), Z, Z + 16, , , 1.1πNEXTππGET (0, 0)-STEP(100, 100), ScreenCut%πLOCATE 15, 1πPRINT "100x100x256 Color Circle"πPRINT "saved into memory."πPRINT : PRINT "Press any key to change backgrounds"πPRINT "and print sprite."πDO: LOOP UNTIL LEN(INKEY$)ππCLSπLINE (0, 0)-(319, 100), 5, BFπPutSprite x, 0, VARSEG(ScreenCut(0)), VARPTR(ScreenCut(0)) + 4, 101,101πLOCATE 15, 1πPRINT "WOW! Notice it DIDN'T destory the"πPRINT "background!"πPRINT : PRINT "Press a key to something cool!"πDO: LOOP UNTIL LEN(INKEY$)ππCLS : T! = TIMER: x = 0πLOCATE 24, 7πPRINT "thousand pixels per second!";πLOCATE 25, 6πPRINT "updates per second!   WWWOOOOWW!";ππDO UNTIL LEN(INKEY$)π    PutSprite RND * 219, RND * 79, VARSEG(ScreenCut(0)),VARPTR(ScreenCut(0)) + 4, 101, 101π    x = x + 1π    Z! = TIMER - T!π    IF Z! >= 1 THENπ        LOCATE 24, 1π        Z = INT(10 * x / Z!)π        PRINT Z;π        LOCATE 25, 1π        PRINT Z \ 10;π    END IFπLOOPπScott Pessoni                  LED DISPLAYS                   FidoNet QUIK_BAS Echo          10-02-95 (18:36)       QB, QBasic, PDS        228  9481     LED-DISP.BAS'LED-DISP.BAS: Version 1.0π'Scott Pessoni - August 1995π'π'These are some subroutines that I wrote to simulate differentπ'kinds of LED Displays.  This is the first version so it's not filledπ'with to meny fetures but they are handy at some time.  The Ledπ'Display does not handle negitive numbers or decimals.  You also haveπ'to watch out for LedBar so that the formula doesn't overflow with largeπ'numbers.  The Leds aren't very pritty yet but I'm working on digitizingπ'some!  The Leds are handy for showing the status of something becauseπ'all you have to do is change the the led state and not remember theπ'X and Y locations!  Have fun and tell me what you think.  Look forπ'version 2 some time.π'-----------------------------------------------------------------------πDECLARE SUB Leds (LedNumber%, Status%)πDECLARE SUB LedBar (Number%)πDECLARE SUB LedDisplay (Number%)πDEFINT A-ZπDIM SHARED DisplayLedX, DisplayLedY, LedDigitsπDIM SHARED GraphLedX, GraphLedY, GraphElements, GraphNumππSCREEN 13ππ'This sets the default colors to use for the Bright/Dim led panals:π'Red Leds:πPALETTE 16, 65536 * 15 + 256 * 15 + 57πPALETTE 17, 65536 * 2 + 256 * 2 + 19π'Green Leds:π'PALETTE 16, 65536 * 15 + 256 * 57 + 15π'PALETTE 17, 65536 * 2 + 256 * 19 + 2π'----------------ππ'-------- Led Digit Display Setup -----------------πDisplayLedX = 0 '|- Upper Left corner ofπDisplayLedY = 0 '|  Led Digit displayπLedDigits = 4   'Number of digits to have on displayπ'--------------------------------------------------π'-------- Led Bar Graph Display Setup -------------πGraphLedX = 0  '|- Upper Left corner ofπGraphLedY = 20 '|  Led Graph displayπGraphElements = 32  'Number of graph elements. Maximum 32πGraphNum = 1000 'The number when the graph is 100%π'--------------------------------------------------π'--------- Led Lights Setup -----------------------πTYPE Ledπ     x AS INTEGER '|- Upper Left corner of LEDπ     y AS INTEGER '|π     s AS INTEGER 'Current Status of LED (-1=Led not used 0=Off 1= On)πEND TYPEπDIM SHARED Led(5) AS LedππFOR Temp = 1 TO 5 'Make LEDs unused until you assign themπ     Led(Temp).s = -1πNEXT TempππLed(1).x = 40: Led(1).y = 5: Led(1).s = 0  '|- Make some LED'sπLed(2).x = 60: Led(2).y = 5: Led(2).s = 0  '|π'--------------------------------------------------ππ'============ DEMO:πLedDisplay -1 '|- Any negitive number will Clear/Create displayπLedBar -1     '|πLeds 0, 0     '   Draw all LED's at there set statesππFOR Count = 0 TO 1000π     LedDisplay Count   'Update Led Digits with current numberπ     LedBar Count       'Update Led Bar graph with current numberπ     SubCount = SubCount + 1                          '|- Every 10 numbersπ     IF SubCount = 10 THEN Leds 1, -1: SubCount = 0   '|  toggle the Ledπ     IF Count > 500 THEN Leds 2, 1                    'After 500 turn Led ONπNEXT CountππDO: LOOP UNTIL INKEY$ <> ""πENDππ'LedBar: A simulated Led Bargraphπ'-----------------------------------------------π'LedBar Numberπ'    Number = The current number you want to update the bar graph withπ'-----------------------------------------------πSUB LedBar (Number)ππIF Number < 0 THEN 'If Negitive then blank Bar Graphπ     FOR MakeGraph = 1 TO GraphElements * 2 STEP 2 'Make the Bar graphπ          LINE (GraphLedX + MakeGraph, GraphLedY)-(GraphLedX + MakeGraph, GraphLedY + 5), 17π     NEXT MakeGraphπ     EXIT SUBπEND IFππElements = INT(Number * GraphElements / GraphNum) 'Calculate Number ElementsπIF Elements > GraphElements THEN Elements = GraphElements 'Check limtsππ'----------------- Draw Bar Graph --------------------------------πFOR MakeGraph = 1 TO Elements * 2 STEP 2 'Make the Bar graph (Lit)πLINE (GraphLedX + MakeGraph, GraphLedY)-(GraphLedX + MakeGraph, GraphLedY + 5), 16πNEXT MakeGraphπFOR MakeGraph = Elements * 2 + 1 TO GraphElements * 2 STEP 2 'Make the Bar graph (DimπLINE (GraphLedX + MakeGraph, GraphLedY)-(GraphLedX + MakeGraph, GraphLedY + 5), 17πNEXT MakeGraphπ'------------------------------------------------------------------πEND SUBππ'LedDisplay: Generates a simulated Digital Led Display.π'------------------------------------------------------------π'LedDisplay (Number)π'    Number = The number you want to display on the Digital Displayπ'------------------------------------------------------------πSUB LedDisplay (Number%)πIF Number < 0 THEN  'Setup Led Display panelπ     FOR PlotX = DisplayLedX TO DisplayLedX + ((LedDigits - 1) * 8) STEP 8π          '----------- One LED Matrix digit --------------------π          LINE (PlotX + 1, DisplayLedY)-(PlotX + 5, DisplayLedY), 17π          LINE (PlotX, DisplayLedY + 1)-(PlotX, DisplayLedY + 5), 17π          LINE (PlotX + 6, DisplayLedY + 1)-(PlotX + 6, DisplayLedY + 5), 17π          LINE (PlotX + 1, DisplayLedY + 6)-(PlotX + 5, DisplayLedY + 6), 17π          LINE (PlotX, DisplayLedY + 7)-(PlotX, DisplayLedY + 11), 17π          LINE (PlotX + 6, DisplayLedY + 7)-(PlotX + 6, DisplayLedY + 11), 17π          LINE (PlotX + 1, DisplayLedY + 12)-(PlotX + 5, DisplayLedY + 12), 17π          '------------------------------------------------------π     NEXT PlotXπ     EXIT SUBπEND IFππNumber = FIX(Number) 'Get rid of the decimals incase there are someπNumber = VAL(LEFT$(STR$(Number), LedDigits + 1)) 'Chop Number to LED sizeππPlotX = DisplayLedXππIF LEN(STR$(Number)) - 1 < LedDigits THEN  'Clear Unused digitsπ     FOR ClearEmptyDigits = 1 TO LedDigits - (LEN(STR$(Number)) - 1)π     LINE (PlotX + 1, DisplayLedY)-(PlotX + 5, DisplayLedY), 17π     LINE (PlotX, DisplayLedY + 1)-(PlotX, DisplayLedY + 5), 17π     LINE (PlotX + 6, DisplayLedY + 1)-(PlotX + 6, DisplayLedY + 5), 17π     LINE (PlotX + 1, DisplayLedY + 6)-(PlotX + 5, DisplayLedY + 6), 17π     LINE (PlotX, DisplayLedY + 7)-(PlotX, DisplayLedY + 11), 17π     LINE (PlotX + 6, DisplayLedY + 7)-(PlotX + 6, DisplayLedY + 11), 17π     LINE (PlotX + 1, DisplayLedY + 12)-(PlotX + 5, DisplayLedY + 12), 17π     PlotX = PlotX + 8π     NEXT ClearEmptyDigitsπEND IFπππFOR PlotDigit = 1 TO LEN(STR$(Number)) - 1 'Plot each number to a LEDππWorkDigit$ = MID$(STR$(Number), PlotDigit + 1, 1) 'Get 1 DigitππSELECT CASE WorkDigit$ 'Find and select which elements to turn onπ     CASE "0"π          E1 = 16: E2 = 16: E3 = 16: E4 = 17: E5 = 16: E6 = 16: E7 = 16π   π     CASE "1"π          E1 = 17: E2 = 17: E3 = 16: E4 = 17: E5 = 17: E6 = 17: E7 = 16π  π     CASE "2"π          E1 = 17: E2 = 16: E3 = 16: E4 = 16: E5 = 16: E6 = 16: E7 = 17π  π     CASE "3"π          E1 = 17: E2 = 16: E3 = 16: E4 = 16: E5 = 17: E6 = 16: E7 = 16π  π     CASE "4"π          E1 = 16: E2 = 17: E3 = 16: E4 = 16: E5 = 17: E6 = 17: E7 = 16π π     CASE "5"π          E1 = 16: E2 = 16: E3 = 17: E4 = 16: E5 = 17: E6 = 16: E7 = 16π  π     CASE "6"π          E1 = 16: E2 = 17: E3 = 17: E4 = 16: E5 = 16: E6 = 16: E7 = 16π  π     CASE "7"π          E1 = 17: E2 = 16: E3 = 16: E4 = 17: E5 = 17: E6 = 17: E7 = 16π  π     CASE "8"π          E1 = 16: E2 = 16: E3 = 16: E4 = 16: E5 = 16: E6 = 16: E7 = 16π  π     CASE "9"π          E1 = 16: E2 = 16: E3 = 16: E4 = 16: E5 = 17: E6 = 17: E7 = 16πEND SELECTπ'Plot the LEDs to the screen------------------------πLINE (PlotX, DisplayLedY + 1)-(PlotX, DisplayLedY + 5), E1πLINE (PlotX + 1, DisplayLedY)-(PlotX + 5, DisplayLedY), E2πLINE (PlotX + 6, DisplayLedY + 1)-(PlotX + 6, DisplayLedY + 5), E3πLINE (PlotX + 1, DisplayLedY + 6)-(PlotX + 5, DisplayLedY + 6), E4πLINE (PlotX, DisplayLedY + 7)-(PlotX, DisplayLedY + 11), E5πLINE (PlotX + 1, DisplayLedY + 12)-(PlotX + 5, DisplayLedY + 12), E6πLINE (PlotX + 6, DisplayLedY + 7)-(PlotX + 6, DisplayLedY + 11), E7π'--------------------------------------------------πPlotX = PlotX + 8πNEXT PlotDigitπEND SUBππ'Leds: Updates Ledsπ'--------------------------------------------------------------------π'     Leds (LedNumber, Status)π'LedNumber = Led to change (0 to Setup/Update ALL LEDS)π'Status = -1 Flip/Flop State  0 Led Off  1 Led Onπ'---------------------------------------------------------------------πSUB Leds (LedNumber, Status)ππIF LedNumber = 0 THEN  'Update ALL Led'sπ     FOR MakeLeds = 1 TO 5π          IF Led(MakeLeds).s = 0 THEN  'Make dim Led'sπ               LINE (Led(MakeLeds).x, Led(MakeLeds).y)-(Led(MakeLeds).x + 2, Led(MakeLeds).y + 2), 0, BFπ               PSET (Led(MakeLeds).x + 1, Led(MakeLeds).y + 1), 17π          ELSEIF Led(MakeLeds).s = 1 THEN 'Make Lit Led'sπ               LINE (Led(MakeLeds).x, Led(MakeLeds).y)-(Led(MakeLeds).x + 2, Led(MakeLeds).y + 2), 17, BFπ               PSET (Led(MakeLeds).x + 1, Led(MakeLeds).y + 1), 16π          END IFπ     NEXT MakeLedsπ     EXIT SUBπEND IFππIF Status = -1 THEN 'Flip/Flop the state of the Led.π     IF Led(LedNumber).s = 1 THEN Led(LedNumber).s = 0 ELSE Led(LedNumber).s = 1πELSE       'Assign Led's Status if not Flip/Flopπ     Led(LedNumber).s = StatusπEND IFπ        π'---- Update current status of the selected LEDπIF Led(LedNumber).s = 0 THEN 'Display Led OFFπ     LINE (Led(LedNumber).x, Led(LedNumber).y)-(Led(LedNumber).x + 2, Led(LedNumber).y + 2), 0, BFπ     PSET (Led(LedNumber).x + 1, Led(LedNumber).y + 1), 17πELSEIF Led(LedNumber).s = 1 THEN 'Display Led ONπ     LINE (Led(LedNumber).x, Led(LedNumber).y)-(Led(LedNumber).x + 2, Led(LedNumber).y + 2), 17, BFπ     PSET (Led(LedNumber).x + 1, Led(LedNumber).y + 1), 16πEND IFππEND SUBππDave Navarro, Jr.              PB FADING ROUTINE              [e-mail]            Unknown Date           PB                     71   1683     PBFADE.BAS  $CPU 8086                 ' program works on any CPUπ$OPTIMIZE SIZE            ' make smallest possible executableπ$COMPILE UNIT             ' compile to a unit (PBU)π$DEBUG MAP OFF            ' turn off map file generationπ$DEBUG PBDEBUG OFF        ' don't include pbdebug support in our executableπ$LIB ALL        OFF       ' turn off all unused PowerBASIC librariesπ$ERROR ALL      OFF       ' turn off bounds checkingππDEFINT A-Z                ' default all variables to integers for maximumπ                          ' speed and minimum sizeππ%FLAGS = 0π%AX = 1π%BX = 2π%CX = 3π%DX = 4π%SI = 5π%DI = 6π%BP = 7π%DS = 8π%ES = 9ππSHARED Target$ππSUB FadeOut() PUBLICπ  IF LEN( Target$ ) = 0 THENπ    Target$ = STRING$( 765, 0 )π    REG %AX, &H1017π    REG %BX, 0π    REG %CX, 255π    REG %ES, STRSEG( Target$ )π    REG %DX, STRPTR( Target$ )π    CALL INTERRUPT &H10π  END IFπ  FOR J% = 1 TO 32π    CALL FadeDAC( -4 )π  NEXT J%πEND SUBππSUB FadeIn() PUBLICπ  IF LEN( Target$ ) = 0 THENπ    EXIT SUBπ  END IFπ  FOR J% = 1 TO 32π    CALL FadeDAC( 4 )π  NEXT J%πEND SUBππSUB FadeDAC( Inc% ) PRIVATEπ  LOCAL Buff$, N%, K%π  Buff$ = STRING$( 765, 0 )π  REG %AX, &H1017π  REG %BX, 0π  REG %CX, 255π  REG %ES, STRSEG( Buff$ )π  REG %DX, STRPTR( Buff$ )π  CALL INTERRUPT &H10π  FOR J% = 1 TO LEN( Buff$ )π    N% = ASC( MID$( Buff$, J%, 1 )) + Inc%π    IF N% < 0 THEN N% = 0π    K% = ASC( MID$( Target$, J%, 1 ))π    IF N% > K% THEN N% = K%π    MID$( Buff$, J%, 1 ) = CHR$( N% )π  NEXT J%π  REG %AX, &H1012π  REG %BX, 0π  REG %CX, 255π  REG %ES, STRSEG( Buff$ )π  REG %DX, STRPTR( Buff$ )π  CALL INTERRUPT &H10πEND SUBπEarl Montgomery                IMAGE MAKER                    FidoNet QUIK_BAS Echo          09-29-95 (22:21)       QB, PDS                174  10697    IMAGE.BAS   '>>> Page 1 of IMAGEMKR.ZIP begins here. TYPE:BINAA TLEN:7669πDEFINT A-Z:DIM SHARED K,S,B&,Z&:V1 'Created by PostIt! 7.1πSUB V1:OPEN "O",1,"IMAGEMKR.ZIP",4^6:Z&=7669:?STRING$(50,177);πU"%up()%9%%%#-%7f.RDI5(0Wr&%%%)k%%%/%%%%ht%qtwx%Sgns*fhfoB<eπU"9U/n/D8p??d?[H)TIGzm-,c3e.[n$Q1Ps(1BK7jJR>,7B]1%J[Ug0?\gFGπU"MXG>^gid5*(cKT:\fp'NY24c3-BX]fcHi2=iEAjPpvT3-19*S8?VWjK^;&πU"l?VQ^W--]rGU6Ta,ZMGdpE,NOEKr7)-AjiGIj<?C2.Vz?>r17f+I1R^RIkπU"K[W<Z1h'/=Z\Is6J4QBBG8(m,<d[E<LH>JikaWdMS+=I3<#,H-ku>Z(DIAπU"6WAs6E*,aLqep>LuA:m#slfveu[mbZOn722/,ajj</9u*=<19*1S?P0,+YπU"'<tN_[t=oxtCDk6X+ZY;h1NH+zFCvnK\2*$F$\&3RrlR)AKVWg,.B>edX&πU"W=SOrW^iWm1<19d*SMhT[sMsU6pOH5cRO0%%%%%#%%%O%nlz(%['%%d%%XπU"k%*up(%)9%%[%-%0B+bDd9]J,2#/%%u%C%%1%%%%n%rflj%rpwS[gfx.h(πU"<BTo16w'j>vV&Kdnsmf[7KLOpKC3Gj/Zv#mcph<4Cs*JaEX\aqcmCYekdZπU"[*e7-toM2/enq0*THcQ,RQ;i*d]D['VUn(RXC5vL\EV0XrO:P:EF/YTlw4πU"NiHh:LgHUnDQJ:-rS*&od&BwL$;S(0[,e%ByP8M37YkWNSjDw-#^4ExH$;πU"mK7)m;R[^1[X&.tL][t$bOt2'et'EunS]c%F-keWeIf9:]xPCAQtU[KbG[πU"%,_&>Q\8Yd9)U4>p3KI\Kd.bsZ.\+N(-X+QnCzX#T3-XE]iehaiI:k6?gXπU"MODr:wxiX*Bxh5*#$b&VGUBghp,('V+xSJ>fzO<WBAvHiT98e]^DMH7xaTπU"=+j%;<QeNQZ_/YM.7qB+5*3Y<Bm9&L=b<jrnRYZ(G/DzT;^C>OY:sHCAtsπU"n%.uiUSR79Kk\m9^':n%'vUS1/*=bKalj<j.JovSXhC5m1RBYC?M[xJy6(πU"+gx#pRv_j.Ks/kL8G-VolZIf,eJI*8i.jQ?G+q6W[tqd9G8?GA]Gb#.ZC]πU"D7K<U&7Kt9N_&?3_,_;NL,PBpETV)^Asf1>ni1&k;4P>y<:.L?zN(a?P&9πU"mC_K3z1pY,H+/4W^Mh*R?U/Po*>PNVKVNVk](hfGZ<MGB3lIFA**JQ'bE,πU"'uMY:GttI[UWW0(d=l8:oBlvj(zN?%QPkJ?rxO>ae;gnQcRtwQ3JT'LSCFπU"*D-bNKnIPw.f++tUhVx1nH*44.a2SzD+tfj7YoNSO^O^UEVZ(D<D*r=8HDπU"B(%?aJaLjCS)%A#[%]AO<7:CoqlTCEnBN^o-p1-uV^aV8fw7W=<<Jk1,C-πU"o(B[co<T+ScBF1B%BZhQ&I6G]:&/iQtIvG]2BYiQ.J$G]<n/j%/AqjAAJiπU"<UyuCDh]H53lz:j-UhVY&0<Z[N/Aq-,X=JzrA-,,hYT(qa/T-T*:T0Td)TπU"Of2rG]RcVif+B&j6+vr18?ugNY-/PLQ:dmUgvE+;Ow/0BBUq<'j1sgUm2DπU"L>3>OApYeK84ehuv)\\8yA1PkU:9<%_YMQS<x*QutQ^vA0ji*UL\Pm)iy7πU"eZ5S8ig(5+0LuQ3djX/0j)f<b;Kl3<RWs)Hbh$imUJ8Z#K0;a\v[NFHB%?πU"m-NenO,qk51#aF=HCqkz0]i8r7l_W*L6FkhCB1H]KhhHEPN<9Vxr$'/u9]πU"]'COJ0zar_lu-4Rt73$*Y^[oLY#?UO1^eB%wS*8op//aHq9h[w+4j5]4Y$πU"4k-1<C9zTF0]zN]4)GnJ3B=jZ6WU0'JXNHZ3Oc'N*D/BLcZ0]CKa+5gBSYπU".(8iHG:tqu.95.7<zle.NI]W8p+;?MS?2x'Bbr41&l,2OiGjRQagp[hCOmπU"Q+[N_:BY^\pxDJ_dj]WfoOeAg4')j\D.=QE=BOEC5\;_S5YTt8Ao1ymO<,πU"vTX-_)m)#/E>//DW#cdq0T4pP;h0g=DEbX]RS-VX$il6#/G%Lx''LL+X3?πU"VBZex](#WHYtK2fs#w;#QloOLY+4tN7(P=3^H*9x^1NlBBM_.S=xPf9QpJπU"qK,(V2]v2MUgPesnsLMpoi&U'=,vJZHxwMia8uciV#v\xWh^QI5cIqiDwyπU"uonCo>/OzaH%+&fyUXwg/CAmiKL$[c%=g_TOff^nS'5UYJL=5_[1saO/6jπU"s2?$>cvcBVZrYC-Pn0=BPTzX&<za=QG8Y,bR2WvouU;1<a=f:>WQh.*FKGπU"KWP,1//yy,BULfVR\&J<0A?dC[5uQ#C)i'))&.Z+d7&N?ZHgDU)GsT]z6PπU"MHHE-*U>J06x=5CB%zFx%5(1grCh(X%CT^]Yr81]dm^YGuEhbY*B/\W7hgπU"oJZgw)HkiQhHH(9Z&Zo/6FxGS-p98W<YN$vAemWzR]$ImAElGqDpE$lhqpπU"]qc)_77B=.CB]d;aj(:AP-o8kH]BPLYJ'Y(BN<\udZ+YvILXNd[^+=Yc<dπU"dcA42I+J%E:?7O6Q'QN8ITXJfN/983+GwSlUo*Y,?P1k_G#6vabI9GKWhCπU"MmYnocSbNxB>JW9+lU*jh4*h0U89i$r^s,V8U1Qtmh3+=$/[b=H?sAG^jvπU"=^]U,.vhu1E[+e3G,#+Q6.\OQQV8TOxRT6fHB7k5%I#q<*/5T=[1VS*a)GπU"LP?<]<c1XFXdm4gf1_A,3(NOer$g(Ac^NtZ;e:=zpR7oV;V]\YUh$A&V#pπU"dc=<3fvfw:s/Aar4-&AO0mr6eP=)m%Ks8mf(rFHJ#=kEb)e?0(eUVZ8+OrπU"R=2=uVrdVS/=9/rmBi^IAcKSRXC[.5RJDJi.;zA086FA,=WJ4Ub=w\K1wYπU"+[fpxgWT$i<ngg=Q)QX7VJ^H;?lq-nG']x%DcuPS>C6G1r;,YeI4)T6QjoπU"*(9bh(nBI<qzj09Z>'S1DfQBkmW3o1u8Z07/M#1qubd/0(G7>pp61cwXbwπU"i5GCsl8^DB,O7a[\w][m<Me(sM9jnK8COLCh^#di3l\Gz6CHedPcgN3hLUπU"bM;?1_Zc7c%dBA&l:(66Hp.eB^JdlQPq>eM.oVAa/>N^V&=Xk0Jz0mBHXHπU"KL;a8.GDQDd0vFfH;KD7hGsLZRZA=B$(5&6bY4%Npb+?:,nEa4p'h40$9AπU")8&hiZ()1eEUkS/UHIN5;1(Q<gc)&7:]/Z)#,OY=6mA2:LC5+(Q8:iiZhSπU"]UY%>5aHFg0i?;WUY#C5K8QnrjLJ,rR[EE-\-)#YBbi[B(g#_WojL<JrRZπU"(ECr-B';r&&^KVJIJV5ttz>LNK\n[8G8Ep&qZwTO.VqXnV[hb9FVnQ.0<UπU"tK4V_ulBU7h^%OVJLLV5vvl>Nz%N>cmshin4J76lv_7qFBT=,rFeneaR.WπU"e*q1qcU[^G)/&#B+-HkdKVeqZk9$>bFq3jEqW<S\;rXedC]Qa+BklRqym+πU"k[.7fATQg61,C=((2&m#hsQZ\,7hS3e'[jVT;>7rCZ>cDNEM:tS\NZ3iatπU"aYZ7TAlLUaLO1hC.]7f<vDv%IiB>&1;6./Y*Frk)iShJiP(>^p.?>N3ZZ%πU"r3F3n3A6:2.5N=&Y6Q4/LdOFTAKU_N*H<p^oIr;a'[%1#bkm'?]2n-,68<πU"VTH&JlK3j&lDslr^5b-t*Tl(H&vpn?Wq<^+Whu>QRaaq+W+cBTVX,ff=AJπU",b-tMuJwI4(:=F)*yJ<sR[NV*<H(Dk..%[EFl#'?NP4nZxs3pBd\P^;>>gπU"q*HV[^8=d_Y7n3D2Y,6:;avH$qm$:Tg9FB:C&t7prB^By)OHv\qt&u$PZcπU":N?6;vFBcU9I1N^.q.?(Pw2%up()%9%%%I-%Kk7$D_G>caZ%%%%9&%%%/%πU"#%%r(%wjfi%Sgfx+xi4-?jmpxD?A1EmzU]^Lw?#D-lm0v5?M\'MAQ+LC:QπU"wB1xBbw\Z9Ol.p:a8Bl9oZIx:Yb\ZwxlSY:ED(QCQ:+7lw9g1\OcMRlR+GπU",vE;'x%Ep&xEVb[dJvH-BLtn-:Fdm4&A?1/Yy?1\%u+RE_'ycJ'>k(Mdy/πU"zZY\huM0wxoo(%Kfl[bzYMhjgmJy&&q%.9+>#v&y:Sw5[^0I1cu1u?F2L&πU"ixrSo(N&m&wh$#?6'sVkLuP9W(T=I5?qoP0%r/]%.zAND488>xYg4mY5AYπU"?^[^'%%up(%)9%%#%-%'Am$Dk=CbBM[&%%6%&%%0%%%%r)(&wn%yjSg.fxπU"Dv3D=Qej9Vjqg(,lQI2I7sB*6<,Do]2XI'&i7_Frqf8sUL1rQ/87R<IfyeπU"j$Fg,HF(vAk*vW_tnW1T<&O;^8S>u0jP<7'/hGodvCT:gz.?[(/foEJ,J[πU"TjN_]$+Q9z3<pp$DPW?\OBKZ/(WC)]w^Z5CoP<rc\7MOi/MT%6)VJ(dmBdπU"szj):zMY=L^4eZ>8Ar%_>F9&sGMM3r(cDYuP78U($D)5ylSk60<0f'f[->πU"CQF_DFe>C*QgErE-_R3C[BQ\=ZZ?i:FJ8*mpUn/PS',4*kSnZRgYM5RDN-πU"BJ%]Ew9XxmawGjBvy#6[vQn45sBg&MYt<oTJ2I#oB$:jNjB+)=T>TjAmu2πU"%2Fe-Ao>Z)z<iD-Ns1,&Fdup%()9%%%%-%(OKbDlxSO-&9)%%''/%%%1%%πU"%%nrfl%jrpw%SithVT%X>BT[5MOTIN/Rt<mpUTP/C+PO>j%&$v7h2DaRHWπU"3%Jqpx,>#jG:aVYrxM;Fs%i,aJ.+q;(p\?4h7$X/w$igTu&bu[p^TU\>XKπU"<#;Oe(O;&0YrvGcV7jhir0fIREI;/Tck7eAN*w/:.r.4hfX/D_<97i^';DπU"Xe)hj8+T>&g9/*>V8&'#5j>0o:O1hvE?'E;yN>Eaat'Zf/2U#S;W[1XuSeπU"jCS?TM;E-VB]Ci/l:tp)1eJcQOC1X-S4.QG9$^_KQ5'>7Ex'O#i(P8I6ZkπU"L-YcE<Ct3't/xB]>jvSH;_Z('PD5^t7+(i;S%f&/Kja/o#(&-z&Pzl4iZWπU"9(v/nsN032x?n'N]IU/<.f9c&/mi2>[Vw-a_Ic&glIo0hK?C\B/OB>qm?[πU")cnvkpVSQK%y2x2/*zo#['HY$hbNQnS'\l<Vw;(+WGU/](bD)z(wtKHm''πU"v8RIDrXdC+/h,aRLsuBg#(f)Lz94*Z>P*656=jmxm((L?tCAp8dRiE\aaAπU"a(10.6Y#FKa(.>Av<Haq\TNm<(cNuJ%cET?Sjg1;3p](J:WL%bmek'0hc_πU"<I_,f6FdnWE9R3Jlr'</G#bU&niLjD3QuKz#4gO:G')zPM1l+Qx\4zEEV0πU">mJ%4$8jJa,fMC[uvHo;,]f_9Q<ts834\tJ''ormfHN\oB'/f1,VKia[(NπU"N+w(aS+J0DgHkaV4InL<lpXelVDiEuezEy>KvWl-<i<;:F6%hcQ\wV%A?&πU"y*Ij5RaGwL>__LdxcDEgkRowWbV5g<CL.yu28gW^7eI,]?iJp<y7eFxh)HπU"SW8Fp4i1W6lC0#Pbml6U)ELOiETeqAqi1y8l*KgK#0s9cs'JHh54kh<O0FπU"_8[s5<g(hB?aUU>22wyUXGSfo(kbZKG3\owh=D0Ewa=k.U;XlBi0+F]]LhπU"JjXR&T,IS&/Vhc.0H,OZ*Zpo6JuD6\U\x.=1E2&BBL&I,LT>(OSOE[]q*HπU"]KKIdT_)K6G^SNr=BlT4V#B457O[A'K[JI'RFAAXXLwNCE^n1h&)zMCGQnπU";a-RuKEdsSud5e'pbKHMjTqvl+tIWBWSP,3O_ejGBjJ38-Oak]+j+/>oMsπU"B=XpbFjQsPK.k.SK>.I?o$N)_%ui([o/DA7c-*2HB^.?2^DS$_;0a=%AmxπU"5q4n[mc.?KU=:1nq6IDbH(6]IR[j($]Adxv\>uo56+98%9H#WQ[5c.Lz(gπU"c7LR2Lh0=u/;+%ilG]Dd0D79;/&QLc0oe$D[vFP-Q;Cc_*KB_&aZSh0sEnπU";>dGGj5nK='8Ou]Z_El[-lw]Wqm0&EoXd.U4_g.Cb3AI.,X;1d-Oaap-x-πU"DhniW5<-)EJbQo/e-q$R-CgPx+rP9nS<lLpN6tIKldTT6A:Zo4%DWpMoAfπU"VJz/Pb(]z:pZqRiiC0;FF<,]AWTe$\bIks'Zdup%()9%%%%-%(:HaDKu1PπU"G%d&%%&K*%%%/%%%%gzlr%fsSgRnsFc<*9<U:5UHMB.$=JOO1_1(4l_9G6πU"lui11L_aCgnEEDpTaYFD<h.Dr/MC=Qb_rJdsVL#/^4p1hN[3ivnDKjn+&)πU"2Q2d/gi4pE*['ijng*%4*OK_%6>E)\(8z%G;59VrBe&E6Gu#1G2c'YhXllπU"$bK*M(%uEuw9u)1-&H33Ph$b\xB<+/_]EX1(/X/8Vo<r=<SS<q4FP;xAGiπU"+0f7q)%$=+S%.bJU_Njk'd'dS'pE<Dl0vVU&J-nHg=++MVH0/gK+NZBZ)bπU"6NGSjJf#/3cB9qmefAM6IIX8qY4Xagn\(k+EAsQJ,I+7tEt(OS41\ci9q5πU"?G>Yk6IBFD;[7=iOrpf\Wr/d7x'wD8hzY=*?q-u^ZILtyu6o3m;'Hhd]4uπU"m6HlXa,sdm\u\AP#UHbr&.up(%)9%%%%-%:\HaDE[K'Jm%%%%%%7%%/%%%πU"%g%zlrf%sSif4yfff+7<E-#jX1j;=ilD<0Za9m159I:[l9OX0X#>py+g1mπU"HB)Mo?\rHAeXZGr?IrInAJR#/1p83CUsrfcr3'(k.\*CqiQe8sijIf1^'KπU"D8jPa?#HPgvJKr0CdPgN)Ac:azrfppMcrWZ.*aJ*-lOWl_HGaO_*s6MD[rπU"*-t]7Nuw(_KHv6igtvFf(Dh^gUSt_^3ch^>4tdu6X6goFTgKk>l##Gnnl)πU"J.a<Lt:xHS0vzLcgyn>Nu$l$gtfstjiqEn4<X:t8XsP3*u&8COZglt7P&DπU"Cxu4Fo00lT_=rx[P>tN88'l98M5%%up(%)9%%[%-%tAH\DquR<LL%%%%%%πU"7%%/%%%%u%flti%fSifsyNQJ+/<E1#*u,Hp6YvwKHRB;kg=3S-^CqCA%OAπU"ZPDOg[(M8ju];+*nn?gv,i_In99\X_Dqlzj0nJq^%b]pv\Xh<w;s9)HnOBπU"v%^cp2c\c$mu8hAlfs-(w\buKhbSu0tnvf7Sl$_l+x0PH7tBVRSH*Y<XO*πU"QZ&fio3,DpYCg$^-wcF4uq7GlM]^MMZuqXnsdQrxk.x.UZsL'pm-D2wl(xπU"MfrxL#hGNic5?xRO&Qjt6(Z#%i#K\8(NYpdXl,LhI(QxugW:$l2%%up()%πU"9%%%R-%tHR\Dq3:.&q%.%%K*%%%/%%%%uf%ltif%Sgns<Nb6sB<U9T*(#JπU"T5$K=mIE_E<T_3br9i-5fLRmW$*J;akICF2U:MvwNW/>c5&p(ANR_^w1HtπU"sO=DwpM,N+sdLIiUnyri1f:_jKtbjJ)7CnsyF%Kgwi:HTlQC<+EA88$YBsπU";2mqagqKmLa_Q+AC7f)CY8Uns%+_68)>2012T=I&DgwQ4I>qhlh?J1d?QaπU"HKo(ON;F2w6ujqGsGY(nchoM*ouYe,N$'[LgDLc4+iEa#D)S8aTLYJ/fN6πU">qMtjDrM,7_<GupBB/Ma<o0SqQcw*idj#43PF0GfU3-DO<Y90]esO'8H>uπU"LEt0f6%up()%9%%%#-%)ddbDq6(>Em)I%%o[%%%0%%%%qj%yyjw%xSgnXsπU"fS>.q#4As,iX<_,7Z#+v?7sHLJ8eHef:'qESC3&8IVq>.q?<PZ4)bH>=<4πU"5g9asi'EX5015-'Mqg7G3bnFI6s[i?K^jD5AJVia^:,)\e1OJLnSj5d>\BπU"Qq_mici?;h$jnBb7pW6vZ]ZWV<(%[i%%'idGxEL0*HfbxCmKw7Tu&RJjLAπU"E%f=1Hna7.QJxj(4e_T*J$(-PAtL$p9to4A#Ht'c:3xp,EpGYrAZv/IMPlπU"p<isEO4K,Wr/JP.^B(]i,qQRuW/+ydxT&D%xN]5(y#rOD$6b??qCFLqCE)πU"]VE:]fS<uwc)VqHewkJ9^pIJ\LcA,5T;AN%2[r/Y6FoJry?';I6R_<X0X=πU"kM'tkpzKx'R#B%2n[b.?+C8VZSJZ^[i+jF3HNmq+5C)]VcoN?ttQ?u3QL<πU"=dP1Ch8UhC)]:Vi.kll:vgNl]m==JpJHi4=C)o'V?t_:\J(BJn^u3Pg=NWπU"1^RDV2Ru2ouId58BqrSqj*Wmg?vQ?:vDVBm<B]/'6>pi?NapVDy3gxuRHOπU"hG4f#>mrMbThRqRU''yyZCGzJdsQvBm6e0h$4V3(?G'AyrqqRUEK+QJfRxπU"nhT\)0d7ez4ze$\x[N*ASj,K2jaJ<79fn2qHh:M3aD,YGi8.&3y4R0AryAπU"&)5%%%%%%%I3zawKVK>=->)4_lqhFx$t=V6nm8W&oiv35ue6VLcSqEp5\mπU"U#=9,Vl#/iT%c5bC3Z^6ghNj8K_;*71A[qkZfR[?oyfwkf;EG4G,U7$xC&πU"ur/0=-kH8?'5'lVCj%56+.3sb5LHoG++_uFm$1B,;AbC-fKH(Eh8'Q*uy<πU"Xi_WL5iSiBF4gJ0pMFBBNkiT]PtgVBLlqY'?<5AF9s6]/sokwo'($=ZpZ^πU"D>\s4RSBQUt*)iU>kh?FLKps8NP-E[zGQWu2E:il#JB;9eDt>N6gULLmj2πU"D)+.,lq;X$jJfjWSGnD:pGQU$9nt>[S>pF9S%Q&c8yZ'w'Nug8ljt\?0+KπU"8'tQu$nV9if>c5GY<+$;DY-wY\[OcAN-+dSmdT0dU'NOsWOn/B#\Smk#>rπU"ep&mZE1X'fk#Nn.?8aSsGAfsi>+xXS>y&v0MyX^C.iM%s,6?Hp\nVaZ'7VπU"J\APK2pGQU'PtDjvVNxW%MValp[X$w>Js=*Z(Ks0kPu8''mVlF%<cN$[XcπU"Av?SMF$5e]:%?(hH$OERNu(HpOsU-N_NxY^]ehiAO0CdrGQUeisb&,Vf>hπU"b1wz9*lca#&kpF^E[N)b-S50>\(<5]4d(b9P;aHul/_T#TE+Ae_O/BxYJmπU"HUuV.^=^hNcD6:H,&r:I(I/9#EC%k5%%%%%%%%%%%%%%%%%%%%%%%%%%%%πU"%%%%%%%%%%%%%%%%%%%%%%%%%%%%%^%oVw%+up&%'9%9%%%%-.%7fR(DI5πU"0&Wr&%%%)k%%%/%%%%%%%%%%%E%%%%%%%%%h%tqtw%xSgn%sup&%'9%9%%πU"%%-=%0+b:Dd]J',2/%(%uC%%%1%%%%%%%%%&%E#%%%D%&%%n%rflj%rpwSπU"%gfxu%p&'9%%9%%#%-%K\k$D_pGcaZ%%%%9%&%%/%%%%%%%%%&%%E%%+%%πU"0%.%r(w%jfiS%gfxu%p&'9%%9%%#%-%'Am$Dk=CbBM[&%%6%&%%0%%%%%%πU"%%%&%%E%%+%.1%I%r(&%wnyj%Sgfx%up&'%9%9%%%%-%(OKbDlxSO-&9)%πU"%''/%%%1%%%%%%%%%&%E%%%%+3%%%nr%fljr%pwSi%thup%&'9%%9%%%#-πU"%:H7aDu1)PGd&.%%K*%%%/%%%%%%%%%%%%E%%%&i7%%%gzlr%fsSg%nsupπU"%&'9%%9%%%#-%:H7aDEK7'Jm%%%%%7%%%/%%%%%%%%%%%%E%%%%&9%%%gzπU"lr%fsSi%fyup%&'9%%9%%%R-%tHd\DqR?<LL%%%%%7%%%/%%%%%%%%%%%%πU"E%%%%B:%%%uflt%ifSi%fyup%&'9%%9%%%R-%tHR\Dq3:.&q%.%%K*%%%/πU"%%%%%%%%%%%%E%%%%=;%%%uflt%ifSg%nsup%&'9%%9%%%#-%)ddbDq6(>πU"Em)I%%o[%%%0%%%%%%%%%%%%E%%%%]<%%%qjyy%jwxS%gnsu%p*+%%%%%/πU"%%/%[#'%%x%#%%%%%πEND SUBπCLOSE:IF S=73AND B&=Z&THEN?" :) Ok!"ELSE?" :( Bad!πSUB U(A$):FOR A=1TO LEN(A$):C=ASC(MID$(A$,A))-37:IF C<0THEN C=91+C*32πIF K<4THEN K=C+243 ELSE ?#1,CHR$(C+(K MOD 3)*86);:K=K\3:B&=B&+1πS=(S+C)AND 255:NEXT:LOCATE,1:?STRING$(B&*50\Z&,219);:END SUBπJoshua Dickerson               3D ROTATING CUBE               FidoNet QUIK_BAS Echo          Unknown Date           QB, QBasic, PDS        164  5029     3DCUBE.BAS  'By Joshua Dickersonπ'πDECLARE SUB InitProgram ()πDECLARE SUB MainLoop ()πDECLARE SUB Calc3D ()πDECLARE SUB Rotation ()πDECLARE SUB DrawObject ()π'πDIM SHARED Lines, World(500, 3)πDIM SHARED X, Y, Z, sX, sY, Xa, Ya, Za, sXs, sYs, DπDIM SHARED R1, R2, R3, Sr1, Sr2, Sr3, Cr1, Cr2, Cr3, mX, mY, mZ, Eyeπ'πREAD LinesπFOR I = 1 TO LinesπFOR J = 1 TO 3π READ World(I, J)πNEXTπNEXTπ'πInitProgramπMainLoopπSCREEN 0πENDπ'π'CUBE LOOKING THINGYπDATA 24πDATA -90,-90,-90, -90,-90,90,     -90,-90,90,    90,-90,90πDATA  90,-90,90,   90,-90,-90,     90,-90,-90,  -90,-90,-90πDATA -90,90,-90,  -90,90,90,      -90,90,90,    90,90,90πDATA  90,90,90,    90,90,-90,      90,90,-90,  -90,90,-90πDATA -90,90,-90,  -90,-90,-90,    -90,-90,90,  -90,90,90πDATA  90,90,90,    90,-90,90,      90,-90,-90,  90,90,-90π'π'DIAMOND LOOKING THINGYπ'DATA 26π'DATA -90,0,-90,   -90,0,90,       -90,0,90,    90,0,90π'DATA  90,0,90,     90,0,-90,       90,0,-90,  -90,0,-90π'DATA -90,0,-90,    0,90,0,        -90,0,90,    0,90,0π'DATA  90,0,90,     0,90,0,         90,0,-90,   0,90,0π'DATA -90,0,-90,    0,-25,0,       -90,0,90,    0,-25,0π'DATA  90,0,90,     0,-25,0,        90,0,-90,   0,-25,0π'DATA  0,-25,0, 0,90,0π'π'EMPEROR ANDROSS (STAR FOX)πDATA 142π'π'─────────────────────────NOSE──────────────────────────πDATA  5,-4,10,    -5,-4,10,       -5,-4,10,   -5,-25,10πDATA -5,-25,10,    0,-52,0,        0,-52,0,    5,-25,10πDATA  5,-25,10,    5,-4,10,        5,-25,10,   10,-18,2πDATA  10,-18,2,    10,2,2,         10,2,2,     5,-4,10πDATA  10,2,2,     -10,2,2,        -10,2,2,    -5,-4,10πDATA -10,2,2,     -10,-18,2,      -10,-18,2,  -5,-25,10π'π'─────────────────────────MOUTH─────────────────────────πDATA -10,2,2,     -28,26,0,       -10,2,2,     0,14,5πDATA  0,14,5,      10,2,2,         28,26,0,    10,2,2πDATA -28,26,0,     0,14,5,         0,14,5,     28,26,0πDATA -28,26,0,     0,18,6,         0,18,6,     28,26,0πDATA -28,26,0,     0,31,6,         0,31,6,     28,26,0πDATA  0,14,5,      0,18,6,        -28,26,0,    0,36,5πDATA  0,36,5,      28,26,0,        0,31,6,     0,36,5πDATA -8,47,0,      0,36,5,         0,36,5,     8,47,0π'π'─────────────────────OUTLINE OF FACE───────────────────πDATA  0,-52,0,    -26,-47,0,      -26,-47,0,  -37,-32,0πDATA -37,-32,0,   -37,-6,0,       -37,-6,0,   -28,26,0πDATA -28,26,0,    -8,47,0,        -8,47,0,     8,47, 0πDATA  8,47,0,      28,26,0,        28,26,0,    37,-6,0πDATA  37,-6,0,     37,-32,0,       37,-32,0,   26,-47,0πDATA  26,-47,0,    0,-52,0π'π'────────────────────────FOREHEAD───────────────────────πDATA  0,-52,0,    -23,-33,10,     -23,-33,10, -5,-25,10πDATA -26,-47,0,   -23,-33,10,     -37,-32,0,  -23,-33,10πDATA -37,-18,0,   -23,-33,10,     -10,-18,2,  -23,-33,10πDATA  0,-52,0,     23,-33,10,      23,-33,10,  5,-25,10πDATA  26,-47,0,    23,-33,10,      37,-32,0,   23,-33,10πDATA  37,-18,0,    23,-33,10,      23,-33,10,  10,-18,2π'π'──────────────────────EYES + CHEEKS────────────────────πDATA -37,-18,0,   -23,-26,12,     -23,-26,12, -10,-18,2πDATA -37,-18,0,   -23,-13,10,     -23,-13,10, -10,-18,2πDATA -37,-18,0,   -23,-17,12,     -23,-17,12, -10,-18,2πDATA -23,-33,10,  -23,-26,12,     -23,-17,12, -23,-13,10πDATA -10,2,2,     -23,-13,10,     -23,-13,10, -37,-6,0πDATA  37,-18,0,    23,-26,12,      23,-26,12,  10,-18,2πDATA  37,-18,0,    23,-13,10,      23,-13,10,  10,-18,2πDATA  37,-18,0,    23,-17,12,      23,-17,12,  10,-18,2πDATA  23,-33,10,   23,-26,12,      23,-17,12,  23,-13,10πDATA  10,2,2,      23,-13,10,      23,-13,10,  37,-6,0ππ'πSUB Calc3Dπ'πX = -1 * X: Xa = Cr1 * X - Sr1 * Z: Za = Sr1 * X + Cr1 * ZπX = Cr2 * Xa + Sr2 * Y: Ya = Cr2 * Y - Sr2 * Xa: Z = Cr3 * Za - Sr3 * YaπY = Sr3 * Za + Cr3 * Ya: X = X + mX: Y = Y + mY: Z = Z + mZ: sX = D * X / ZπsY = D * Y / Zπ'πEND SUBπ'πSUB DrawObjectπ'πRotationπFOR I = 1 TO Lines STEP 2πX = World(I, 1)πY = World(I, 2)πZ = World(I, 3)πCalc3DπsXs = sX: sYs = sYπ'πX = World(I + 1, 1)πY = World(I + 1, 2)πZ = World(I + 1, 3)πCalc3Dπ'πLINE (sXs, sYs)-(sX, sY), EyeπNEXTπ'πEND SUBπ'πSUB InitProgramπ'πSCREEN 9, 1, 0, 1πWINDOW (-200, -150)-(200, 150)πVIEW (8, 9)-(632, 341), 0, 15πCLS                    'PAGE 0π'πSCREEN 9, 1, 1, 0πWINDOW (-200, -150)-(200, 150)πVIEW (8, 9)-(632, 341), 0, 15πCLS                    'PAGE 1π'πD = 1200      'View point and rotation valuesπmZ = -1500πmX = -5πR1 = 0πR2 = 0πR3 = .3π'πEND SUBπ'πSUB MainLoopπ'πWHILE INKEY$ = ""π  'R1 = R1 + RND(1) * .05: IF R1 > 6.28 THEN R1 = 0π  'R2 = R2 + RND(1) * .05: IF R2 > 6.28 THEN R2 = 0π  'R3 = R3 + RND(1) * .05: IF R3 > 6.28 THEN R3 = 0π  R1 = R1 + .1: IF R1 > 6.28 THEN R1 = 0π'  π  CLS : Eye = 7: DrawObjectπ  Page = ABS(Page = 0)           'Page switching is used to hide the drawingπ  SCREEN 9, 1, 1 - Page, Page    'process so the image looks smooth.πWENDπ'πEND SUBπ'πSUB Rotationπ'πSr1 = SIN(R1): Sr2 = SIN(R2): Sr3 = SIN(R3)πCr1 = COS(R1): Cr2 = COS(R2): Cr3 = COS(R3)π'πEND SUBπEarl Montgomery                VGA SCREEN CAPTURE TSR         EXECUTABLE                     Unknown Date           QB, QBasic, PDS        101  6519     VGACLIP.BAS 'VGACLIP.EXEπ'It is a TSR that captures any 320*200*256 graphic screen alongπ'with the palettes in ONE Bsave file. Basic loader source to follow.πCLS:?STRING$(50,178):DEFINT A-Z 'Created by PostIt! 6.0πFOR A=0 TO 6:P(A)=2^A:NEXT:OPEN "B",1,"VGACLIP.EXEπT$="abcdefghijklmnopqrstuvwxyz":T$=T$+UCASE$(T$)+"0123456789#$πG"nPfIbK(zbaiaGga$$pib(bqdm(icaE*e(caq9aSd*r*Cb)ug*D*6b)qi*M*Xc)yπG"l)GW*hd)mn*2*Hd)Oo)W8+e)Kq)qfb)Ke)0s)Gob)cf)8u)qvb)Ff)Ww)WEb)bgπG")Sy*Mb)Ig)WA)qTb)Kh)yF)W#b*i)uG)Gcc)ti)GH)q(icaAaGiamcaI(maCca4πG"aWjaieaNaGyaCcaGaGlaihaUaGFa4caLaGn(ca5aqmaKdabcqoaKia5aGtaieaQπG"bGqa4baGcaC(ka4baOambaOcWiaKkaBdGqaeCacbG4bieaVhGqaySacbWIdieawπG"(Ra8baScqnaWkaGbaRamhaScqlaml(bWSaqba3caCaClakaqWaubacdqnaimaL(πG"ZaycaodGd(nax(0aWbavd//////////////////,GySz1rbnetjbfi(GKb)M//)πG"d/+8$$acbUW(u4A(qPjdaCca4A(qPjWeieaJQ(HQ(JY(hBGda8cc4YfaqPjdaWkπG"a4A(qPjdaWkaHY(JaCDdKEAaOP(ydaqPjcaimaqHly(LMo(OamcW1nq6$(Um(u4πG"A(qPPdcieaJcbaHcbaJkbaJaCDdKEeaGRz(LMm(RaOzvaicaP7(46haqPjdaWkaπG"AwfaIaq6o(UqcauAY(ScGMvbGiaGRT(LMm(RaGR4(LMm(RaGlebaLMm(RaGRpbaπG"fUu(uAY(N(Uu(uAQ(PcWOy(Uu(uAY(#cqOyaWiax3aP7(Ak(U(UofauAY(ScaUoπG"(u4A(qPjWaieaP3maAk(cbW$gOba$BJgaOjcaClaqPPcamlaqHlh(LMmaWjaGlEπG"bafUC(uAs(OcqUcaWkihfUW(uAc(bdauAI(5(u4ccaqPjdaCca4ccaqHlh(LMiaπG"qo(fUcgauAI(5(u4ccaqPjdaCca4c6RqPzea8ja6E8aZaS7Pxba6M8aSdd5l6bjπG"a4ObQgGjiEqOK(qJsca98Va#noU(kuAgbaFcaUG(uZamu4Yq$ZinuAQ(UaGMmaWπG"NaOP(4caAUcacbGMPhGqaGRb(LMEbGqaOzvaic/4UnaoInJgWAa67i08cfc7tlmπG"nhYOUgaJaVlybSc20QuZHSB9a44WMSOhcaGJdBYIoicadgSclY#kHNOjXgGhhWOπG"hQgWVSpqUOaWmaZ$8RovUWaquldkSbqltnhsvlYUvxTOFgKOpypWI2HWImmop7YπG"#a7mVCwm4WmTZ839GMgaW0a8VDiOjda4laR$YvbfKMkaq1aG1G5lGDHS6I2HWI0πG"jqkoyAab4aPbKus$Bd2dOjda4laj#qI$jW8K#LxDPmb(qv4EGdndrxlx1ISpi7bπG"D1XgGC)WIgPqJw9RMeaq2aqlpYKCZHSl(iNtlI9V4gWIxFuOQgWQlAecRUOrgSkπG"u5E(0cuZHKLCV4HJEOAalAfc0cuZH8HCGStWZvGXgGCa9SW20raT#0Ci$BNcAQ(πG"mdWxlwExkB(A6(ldW6IB1vE4ObSgGjk6aGait7#giaMOib8acDeWtc1nGrIlVbAπG"Q(qdWbJJGbmITJa$X8KU4WF8Lxlx1ISB1vlAhclsWI#zWIvymb$BCb$RPda4maiπG"wbIeSiYdO84nfuqAQ(vdWvlAhclsNal6Nbl2Naj6J2d81G5lGCVKyhP4GPbeGdKπG"gqsjD0rj#qI$jqu7eSDcSyWlI88KM1kiVt02jWIrVOYlAJ2dmpPlo8$2HGMk(ZaπG"8VDgOPcaWmaF5vxkt)mdW5yG0buhiocSjHcjaMSOhscWOshqIEqDa6BYXgajalbπG"Gjm6GKaS$YZaCogiDa0DHJaVi2hAG0bCOhuhG#MmkKaysIEija7VmuEG72a4i2hπG"BaYbCeaFGLma$mavTi7lANblsNa3tHUGfqOSgWkqFSbZgW$$tBmGcBanhY$$$$$πG"$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$d///aqvlYUπG"vx5YG#Wja$thchBaYbahaRlX$2zGMatGqaCSbihWBaSaW0zWxE1LYe(JoWdbl6fπG"cl#Hli6rVa4cI#4lalAebUmkSaSOrcuW(4YOUcGdFqlnnhsIEOkamAaRa4WbWIWπG"V#bGUyma6NgaSq8RHaOBLdGoNba7e$Qia6U6aOhzaWsXVocGUbpa6ggaSw8RKaOπG"71dG#Eba7f$Aja6kbbOdxaWgYVAcGUOqa6LfaSL8RNaOlweGUwbaRj$kka6IhbOπG"$uaWIYVMcGUysa6efaSj8RGaORAdGEobyXhhBaYb)Pl0$UySb7cW$7ZjutfLuvzπG"1vEyGlmAHSa4sIMqla4UnaoI9G#mB(qxm67i0lAsSbSFVqHaTr1Cij6XSbOjNfiπG"eaU8VlUcWGetGMaxGqaOVloAHSa4YIMqla7FWhF5vxAL1wy1PlgBWU(WWvTi7w5πG"XIEHWIFSW20jGJB7Oh8qWma7iWZMGVccGUQna6YcGCbnlc#6ha6IXaOxkaYrZSqπG"4RHaOBLdGoMai3jZoHVkcGURoa6lcGCAmlf#6ia6g8aO7haY1WSw4RKaO71dGECπG"am3b4c(FSovqo7f#Aja6kbbO3faYX#SH4RMaOlkeGouai33ZwIVEcGUyra6dbGCπG"spRj#kka6IhbOBdaYv8SO4RPaOlMeGEkaihUF8VDi8VDgOPbfiea9)0Dk#E1LYeπG"(u0wtZHKyhmwKayrBjnhYWdYZ$1ja#dlZ$rpE0JBYoxq3a5VE8mITj7CKa1v$IeπG"SitcOVjjEGjj#Ka7J7$$NibjsKaRd9#UaOp$c(0nKla6ZUa8FDi4IXg8l(S#mUaπG"Op6c(1TIht5sXEOk(#daB9bDi4cG#Wla$xheUySb$c(C6Y$E4haOFK$p7I$o8laπG"67Y$U4ha7df5G5Iog0la11aTc0SfK8Gl6yGVaqNby5Y$UiiaAAybcbGlgBWVaibπG"wpZPl#BGUa4Y$EyiaC6I$oOlaDUVYc(NU4Vb6cGl$7HIaWPl#7GUa05#kl(C6I$πG"gOlaU8VhocaNU4Vd6cqN7RS(WjG8daDeWde1TX#nJcu#tSl#BGUaWPl$7HKaWPlπG"#7GUa0jw0vU#U4Vb6cGl$7HKaWPl#7GUa05#kl(C6I$gOlaU8VhwcaNU4Vd6cqNπG"7RS(WjG8dqDoqltUySb8c(D6Y$UOj(Ypd39UlgBaVa8FN7ZPl$7HMa4IXgWl(OSπG"(WPl#BGUa4Y$E4jaC6YJgyladsSaU4Vd6cGl$BJTa05YC6I$gOlaU8VhIcaNU8OπG"b4cWGelGl#7GUa4Y$2GlaDU8#UaOp$c(1zG#U8VlMcGla6ZUa8pDY7IXg8l(WPlπG"$7HPaG#58$mavTi7wD1IEzWI3jWG#mB(uNa3tb6dcWIqZi2c5OW7iCDumdWlENaππG"d6ZSbaqDcCpfF5vxkl(lENal6$IpmVP1P9IcV#3au1IStBunhYul6fclEXcsxNaπG"mQTJcBYIEWAa0cvZHKl(Goma4iWMSJhbaqDjaKJatBsnhICtG#kamx6ok8IEzGjπG"l#LaMC$f3h9w0cvZHSyWDPmbamLb0kvZHyYIh5$O#qWbBnShH6dboInG#)Av3a5πG"$XWdyW)KnJ6db4VU8KhMIGZaGMhMIeVoaMhM#WcI5GS$YamOpwh(1HdTV0Cij6bπG"qeWObcraTr1Cij6H1bSOhSgaTq1CilpOpwh(0rHhZS9HEyDa0cvZHuSfaraTA0CπG"iFSmJEOAalx1ISVOrgmQQb0LYcaqvlYoUb(u$Bhc$BNbAscaGcqxkt(vTi7wDf$πG"ECWIgPWI2zWIuSiDcOeEWSOFiSydl2Nal#ns4LZa4VcY2ndRY7ADUSJYYPYcsthπG"dwDvulQ88MM1xEvh6RS$Ih$VDiOPcaWma$BNbAQ(mdWxE1LYgaWmaVU5vTi7tTOπG"xgS4b$BNbAQ(mdWwDPS(u1ISpi7Vnvus1OvrsRgnhYIgzqJw5RMeaq2amZ25EcaπG"06uZHixalT4WAL1wlwExkl(vTi7lAKbqPPqaWka4cCaqPPqaWkahBa0be(DPS(uπG"1ISVOrgaLMcbaRa0LYcaWXgaDabaWYvTi7hBaYb)l6Lbl#WIxjWIEaDa0cuZHm3πG"bA6(ldW6jStWZvGXgGCa98VDgOPcaWmaDPS)qvlYUvxTODgSidJtr$lsNadeVtSπG"QaW0zalGqNaRlG4ZRPc(nalANblsNaZt6IdZ$$2zGMk(Za8LxDPS(u1ISVOrgKPπG"uqPPgaClaDPS(u1ISB1vl6LblAecgBW6daWcaNhdZi99BVb0lkS$oS#a#U#a5Q(πG"Z8VthnJ03h$IOV4W3h$IyVyXakmmisXcax35lSDDJdOpRpW$1vGthzmbTS4ZAQ(πG"qdW8KU4WF5vxkt(vTi7wzSbghW$l6LblEWcatxd5hn0lENajsK$hF)4vxkl(vTiπG"7xTOtiOPc(nalAKbZR6Id$vxkt(vTi7wD1I2zWImOPc(naJtXI2zWI0jaR8eMCgπG"WJE3jajFPQ4YV4W$BNbAQ(mdWxE1LYc)qnvusz1vvXVhhaOpgh(0zKVyhWIwpGfπG"KgWoYpxoTIAa1zWIypWnRhVtoTO$Z0#oYphjlYH9dhaDse96dn0aZpW6b4HPbKIπG"hKgW6JV4dbf08KMYBcSo2D9LxAL1wyTm(6dYbaqDdmkYbSmavTi7qn1USpqoEzGπG"Cqm4WmLJxgChc$BNbAY(#cWwy1LYc)rLlfaSl7dm4paqNddombIB$USpWuAY(#cπG"qwldLMoaGZamUibfKMkaq1amy#cmhbRKmwlV4WRMIdMgqaoqAajLuIpK4FcG1YtπG"TibhwqIeSixcCyxcKixcSaW0nqI35$G9(DgSyxcK4F#V1Y87XbhBaYb)74GPbyNπG"iA6(fdWooyAa2DXkoyAa74aQbyhbj6aQbSOdMgGXgGCao8l2bmGpKgWYaeLvxXVπG"hhSO#lc$ImSiDcmpPi2WxEL1Y///////.kaqdawDuqdXusqbIDX4cmWac8GGYqPπG"asm5KdmGuuyYXgin9MB0D2BTvMC5b(GbG(qgaVu1eaOgatv3yJv2CMvhBSLhiYvπG"wBVzxzKbGdaiiadfMBU9gDGixzT9MDLfsiaqjabXMCLfgz5bsAUnhDHXgBLrwiGπG"0ciVufi09gi15gBVfgzaGca6cGvhfeiZnMCLvMBGmwyWrxDYvgiVzgiZidm4jdmπG"WGNm1ydiJ9gBVj3CPaG5aq1usbcAH5gzSvMCGKMBJ9MCW9MCHrxzKbIy5bstPngπG"AHvgBGCvzSngAWOcaueGvhf0qmLeuG8svGq3BGixzT9MDLXciVjhibXevTyfi09πG"giHngDPzxy0v2caiuawDuqtnKuQ4Yqbbf9MaGubCvyY5wAUDwiGy1rbn1qsPIldπG"feuGugEPnhDZbYBUbczPn3AHesig(Fby1rbn1qsr(ggGldfeu.$$F///G//*0p/πG"c(Xb0Gc+ytnmn0s0e/"πN=4488:K=255:IF LEN(C$)<>5984 THEN ?"Bad script!"Ksum!":ENDπFOR A=1 TO N:LOCATE 1:?STRING$(50/N*A,177):IF L=0 THEN GOSUB G:L=6πW=T\P(6-L):GOSUB G:W=W OR T*P(L):L=L-2:B$=CHR$(W AND K):PUT 1,,B$:NEXTπ?:IF C=95 THEN ?"Ok":END ELSE ?"Bad checksum!":ENDπG:I=I+1:T=INSTR(T$,MID$(C$,I,1))-1:C=(C+T)*2:C=C\256+(C AND 255):RETURNπSUB G(A$):SHARED C$:FOR Q=2 TO 9:DO:S=INSTR(A$,CHR$(Q+38))πIF S THEN A$=LEFT$(A$,S-1)+STRING$(Q,97)+MID$(A$,S+1)πLOOP WHILE S:NEXT:C$=C$+A$:END SUBπEarl Montgomery                VGA CLIP EDITOR                For use with VGACLIP.EXE       Year of 1990           QB, PDS                244  7068     CLIPED.BAS  ' $INCLUDE: 'qb.bi'πDEFINT K, PπON ERROR GOTO errorroutineπDIM B(500)πDIM d(100)πDIM PIX(1000)πDIM inreg AS RegTypeπDIM outreg AS RegTypeπrestart:πSCREEN 0: CLSπPRINT "CLIPEDv6.BAS": PRINT "Copyright (C) Earl Montgomery 1990"πPRINTπGOSUB keyboardπbegin:πSCREEN 13: DEF SEG = &HA000πDRAW "c142;bm100,100;r4;br2;bu2;u3;bd5;br2;r4;bl6;bd2;d3;"πDRAW "bm2,2;r6;d6;l6;u6;"πGET (2, 2)-(8, 8), dπGET (98, 92)-(114, 108), BπCLSπOUT &H3C8, 0πFOR k = 0 TO 767: OUT &H3C9, 0: NEXTπDEF SEG = &HA000πBLOAD n$ + ".cap", 0: DEF SEG = &HA000 + 4000πOUT &H3C8, 0πFOR k = 0 TO 767: P = PEEK(k): OUT &H3C9, P: NEXTπREM Main Programπx% = 160: y% = 100πcursor:πPUT (x%, y%), Bπinkey1:πi$ = INKEY$: IF i$ = "" THEN GOTO inkey1πIF i$ = " " THEN GOTO inkey1πPUT (x%, y%), BπAA% = ASC(i$) AND 223πIF AA% = 0 THEN GOTO mainkeyboardscanπIF AA% = 71 THEN COLOR 15: CLS : SCREEN 0: DEF SEG : ENDπIF AA% = 83 THEN GOTO preparetoexitπIF AA% = 72 THEN GOTO helpscrnπIF AA% = 90 THEN GOTO zoomπGOTO cursorπmainkeyboardscan:πIF ASC(MID$(i$, 2)) = 75 THEN x% = x% - 2πIF ASC(MID$(i$, 2)) = 77 THEN x% = x% + 2πIF ASC(MID$(i$, 2)) = 72 THEN y% = y% - 2πIF ASC(MID$(i$, 2)) = 80 THEN y% = y% + 2πIF ASC(MID$(i$, 2)) = 71 THEN x% = x% - 2: y% = y% - 2πIF ASC(MID$(i$, 2)) = 79 THEN x% = x% - 2: y% = y% + 2πIF ASC(MID$(i$, 2)) = 73 THEN x% = x% + 2: y% = y% - 2πIF ASC(MID$(i$, 2)) = 81 THEN x% = x% + 2: y% = y% + 2πIF x% > 300 THEN x% = 300πIF x% < 6 THEN x% = 6πIF y% > 180 THEN y% = 180πIF y% < 5 THEN y% = 5πGOTO cursorπhelpscrn:πDEF SEG = &HA000: BSAVE "temp.bin", 0, 64780!: CLSππDEF SEG = &HA000 + 4000πOUT &H3C7, 0πFOR k = 0 TO 767πA = INP(&H3C9)πPOKE k, AπNEXTπSCREEN 9πCOLOR 12, 0πPRINT "Command from main screen:"πPRINT "<G>=Good Bye  <H>=This menu."πPRINT "<S>=Press this key before saving the picture using VGACLIP!"πPRINT "<Z>=Go to ZOOM Edit Mode."πPRINTπPRINT "Commands from ZOOM Edit Mode:"πPRINT "<D>=Pen-Down Mode."πPRINT "<C>=Increases color value."πPRINT "<->=Decreases color value."πPRINT "<F>=Changes color to the same color as one block to the right."πPRINT "<L>=Return to the main screen without saving the editing."πPRINT "<S>=Saves your editing and returns to the main screen."πPRINT "<U>=Pen Up Mode."πPRINT "Use the arrow keys on the keypad to move the cursor. Home moves"πPRINT "the cursor up and to the left. PgUp moves it up and to the right."πPRINT "End moves it down and to the left and PgDn moves it down and to"πPRINT "the right. All keys are repeat keys. Just hold them down!"πPRINT "Press any key to continue."πinkey2:πZ$ = INKEY$: IF Z$ = "" THEN GOTO inkey2πSCREEN 13πOUT &H3C8, 0: FOR k = 0 TO 767: OUT &H3C9, 0: NEXTπDEF SEG = &HA000: BLOAD "temp.bin", 0πDEF SEG = &HA000 + 4000πOUT &H3C8, 0πFOR k = 0 TO 767: P = PEEK(k): OUT &H3C9, P: NEXTπGOTO cursorπzoom:πGET (x%, y%)-(x% + 19, y% + 19), PIXπDEF SEG = &HA000 + 4000πOUT &H3C7, 0πFOR k = 0 TO 767: A = INP(&H3C9): POKE k, A: NEXTπDEF SEG = &HA000: BSAVE "temp.bin", 0, 64780!πCLS : PUT (50, 50), PIX, PSETπFOR y = 4 TO 164 STEP 8πLINE (100, y)-(260, y), 142πNEXTπFOR x = 100 TO 260 STEP 8πLINE (x, 4)-(x, 164), 142πNEXTπx = 160: y = 100πX1 = 59: Y1 = 60πi% = 1πOPEN "r", #1, "zoom", 1: FIELD 1, 1 AS O$πFOR y = 50 TO 69πFOR x = 50 TO 69πLSET O$ = CHR$(POINT(x, y)): PUT 1, i%πi% = i% + 1πNEXT x, yπCLOSE #1πi% = 1ππOPEN "r", #1, "zoom", 1: FIELD 1, 1 AS O$πFOR y = 6 TO 164 STEP 8πFOR x = 102 TO 260 STEP 8πGET #1, i%: i% = i% + 1πIF ASC(O$) = 142 THEN PAINT (x, y), 143, 142: GOTO skipoverπPAINT (x, y), ASC(O$), 142πskipover:πNEXT x, yπCLOSE #1πx = 176: y = 88πflag$ = "jump"πLINE (170, 180)-(190, 198), 142, Bπc = POINT(x, y)πIF c = 142 THEN c = 143πPAINT (180, 185), c, 142: LOCATE 25, 30: PRINT c;πinkey3:πi$ = INKEY$: IF i$ = "" THEN GOSUB putcursor: GOTO inkey3πAA = ASC(i$)πIF AA = 0 THEN GOTO keyboardscanfromzoomπIF i$ = "d" OR i$ = "D" THEN flag$ = ""πIF i$ = "c" OR i$ = "C" THEN c = c + 1: IF c > 255 THEN c = 0πIF i$ = "-" OR i$ = "_" THEN c = c - 1: IF c < 0 THEN c = 0πIF c = 142 AND i$ = "-" OR i$ = "_" THEN c = 141πIF c = 142 AND i$ = "c" OR i$ = "C" THEN c = 143πIF i$ = "c" OR i$ = "C" THEN GOSUB printnewcolorπIF i$ = "-" OR i$ = "_" THEN GOSUB printnewcolorπIF i$ = "f" OR i$ = "F" THEN c = POINT(x + 8, y): IF c = 142 THEN c = 143πIF i$ = "s" OR i$ = "S" THEN GOTO savefromkeyboardπIF i$ = "l" OR i$ = "L" THEN GOSUB bloadscrn: GOTO cursorπIF i$ = "u" OR i$ = "U" THEN flag$ = "jump"πIF flag$ = "" THEN PAINT (x, y), c, 142: PSET (X1, Y1), cπPUT (x - 3, y - 3), d: FOR d = 0 TO 50: NEXT: PUT (x - 3, y - 3), dπi$ = "": GOTO inkey3πkeyboardscanfromzoom:πIF ASC(MID$(i$, 2)) = 75 THEN x = x - 8: X1 = X1 - 1πIF ASC(MID$(i$, 2)) = 77 THEN x = x + 8: X1 = X1 + 1πIF ASC(MID$(i$, 2)) = 72 THEN y = y - 8: Y1 = Y1 - 1πIF ASC(MID$(i$, 2)) = 80 THEN y = y + 8: Y1 = Y1 + 1πIF ASC(MID$(i$, 2)) = 71 THEN x = x - 8: y = y - 8: X1 = X1 - 1: Y1 = Y1 - 1πIF ASC(MID$(i$, 2)) = 79 THEN x = x - 8: y = y + 8: X1 = X1 - 1: Y1 = Y1 + 1πIF ASC(MID$(i$, 2)) = 73 THEN x = x + 8: y = y - 8: X1 = X1 + 1: Y1 = Y1 - 1πIF ASC(MID$(i$, 2)) = 81 THEN x = x + 8: y = y + 8: X1 = X1 + 1: Y1 = Y1 + 1πIF x > 256 THEN x = 256πIF x < 104 THEN x = 104πIF y > 160 THEN y = 160πIF y < 8 THEN y = 8πIF X1 < 50 THEN X1 = 50πIF X1 > 69 THEN X1 = 69πIF Y1 > 69 THEN Y1 = 69πIF Y1 < 50 THEN Y1 = 50πIF flag$ = "jump" THEN GOSUB putcursor: GOTO inkey3πPAINT (x, y), c, 142πPSET (X1, Y1), cπGOTO inkey3πsavefromkeyboard:πGET (50, 50)-(69, 69), PIXπDEF SEG = &HA000: BLOAD "temp.bin", 0πPUT (x%, y%), PIX, PSETπGOTO cursorππpreparetoexit:πREM blanks cursor and saves-endsπPUT (x%, y%), B: PUT (x%, y%), Bπinkey4:πi$ = INKEY$: IF i$ = "" THEN GOTO inkey4πIF i$ = "g" OR i$ = "G" THEN CLS : SCREEN 0: ENDπGOTO inkey4πerrorroutine:πSCREEN 0: WIDTH 80: CLS : RESUME restartπkeyboard:πDIM inregs AS RegTypeX, outregs AS RegTypeXπfilespec$ = "*.cap" + CHR$(0)πPRINT STRING$(75, 196)πinregs.ax = &H2F00πCALL INTERRUPTX(&H21, inregs, outregs)πdata.seg = outregs.esπdata.off = outregs.bxπinregs.ax = &H4E00πinregs.dx = SADD(filespec$)πinregs.ds = -1πCALL INTERRUPTX(&H21, inregs, outregs)πcy = outregs.flags AND 1πIF cy = 0 THENπWHILE cy = 0πDEF SEG = data.segπf.name$ = ""πi = data.off + 30πWHILE PEEK(i) <> 0πf.name$ = f.name$ + CHR$(PEEK(i))πi = i + 1πWENDπDEF SEGπPRINT f.name$ + " ";πinregs.ax = &H4F00πCALL INTERRUPTX(&H21, inregs, outregs)πcy = outregs.flags AND 1πWENDπELSE GOSUB PRINTNOCAPFILESπEND IFπPRINT STRING$(75, 196)πINPUT "Filename to load"; n$πRETURNπPRINTNOCAPFILES:πPRINT "There are no .CAP files in this directory."πPRINT STRING$(75, 196)πINKEY5:πi$ = INKEY$: IF i$ = "" THEN GOTO INKEY5πDEF SEG : CLS : SCREEN 0: WIDTH 80: ENDπputcursor:πPUT (x - 3, y - 3), dπFOR d = 0 TO 50: NEXTπPUT (x - 3, y - 3), dπRETURNπprintnewcolor:πPAINT (180, 185), c, 142πLOCATE 25, 30πPRINT "    ";πLOCATE 25, 30πPRINT c;πRETURNπbloadscrn:πCLSπDEF SEG = &HA000πBLOAD "temp.bin", 0πRETURNππZabudsky Aaron Scott           WINDOWS BITMAP VIEWER          FidoNet QUIK_BAS Echo          Unknown Date           QB, QBasic, PDS        279  8837     BMPVIEW.BAS CLSπINPUT "Filename to load: ", filename$πOPEN filename$ FOR BINARY AS #1ππheader$ = SPACE$(14)πsizing$ = SPACE$(4)πGET #1, 1, header$πGET #1, 15, sizing$πbmpinfosize = CVI(sizing$)π'bmpinfosize - Is the size of the information header for the bitmap.π'              Different bitmap versions have variations in filetypes.π'              40 is a standard windows 3.1 bitmap.π'              12 is for OS/2 bitmapsπ'The next routine reads in the appropriate headers and colour tables.π'nbits is the number of bits per pixel - i.e. number of coloursπ'1 bit = 2 colours, 4 bits = 16 colours, 8 bits = 256 colours, etc.π'the 24 bit mode does not have a palette, its colours are expressed asπ'image dataππ'Design of a windows 3.1 bitmap - Taken from bmp.zip on theπ'x2ftp.oulu.fi ftp site under /pub/msdos/programming/formatsπ'Specifications for a Windows 3.1 bitmap. (.BMP)π'Email any questions/responses to me at [e-mail]π'or post to alt.lang.basic or comp.lang.basic.misc.ππ'       | # of   |π'Offset | bytes  | Function (value)π'-------+--------+--- General Picture information starts here---------π'  0    |   2    | (BM) - Tells us that the picture is in bmp formatπ'  2    |   4    | Size of the file (without header?)π'  6    |   2    | (0) Reserved1 - Must be zeroπ'  8    |   2    | (0) Reserved2 - Must be zeroπ'  10   |   4    | Number of bytes offset of the picture dataπ'-------+--------+--- Information Header starts here -----------------π'  14   |   4    | (40/12) Size of information header (Win3.1/OS2)π'  18   |   4    | Picture width in pixelsπ'  22   |   4    | Picture Height in pixelsπ'  26   |   2    | (1) Number of planes, must be 1π'  28   |   2    | Number of bits per pixel (bpp), must be 1,4,8 or 24π'  30   |   4    | (0) Compression - 0 means no compression, 1,2 are RLEsπ'  34   |   4    | Image size in bytesπ'  38   |   4    | picture width in pels per metreπ'  42   |   4    | picture height in pels per metreπ'  46   |   4    | (0) Number of colours used in the picture, 0 means allπ'  50   |   4    | (0) Number of important colours, 0 means allπ'-------+--------+--- Palette data starts here -----------------------π'  54   |   1    | (b) - blue intensity component, color 0 - range 0 to 255π'  55   |   1    | (g) - green intensity component, color 0 - range 0 to 255π'  56   |   1    | (r) - red intensity component, color 0 - range 0 to 255π'  57   |   1    | (0) - unusedπ'  58   |   1    | (b) - blue intensity component, color 0 - range 0 to 255π'  ...  | ...    |π'  54   | 4*2^bpp| total range of paletteπ'-------+--------+--- Image data starts here -------------------------π'54+    | width* | Bitmap data starting at lower left portion of theπ'(4*2^n)| height*| image moving from left towards right. Moving up 1π'       | (8/bpp)| pixel when at the right hand side of the image, startingπ'       |        | from the left side again, until the top right of theπ'       |        | image is reachedππ'Note that this format is slightly different for a OS/2 Bitmap.π'The header is the same up to (but not including) bit 30-π'The palette colour values follow at bit 30, with the form...π'1 byte blue intensityπ'1 byte green intensityπ'1 byte red intensityπ'For each colour of the picture.π'Bitmapped image data follows the colour tablesπππ'Special note: When storing 1 bit (2 colour) pictures.π'8 horizontal pixels are packed into 1 byte. Each bit determinesπ'the colour of one pixel (colour 0 or colour 1)ππ'4 bit pictures (16 colours) use 2 nibbles (4 bits) for each pixelπ'thus there are 2 pixels for each byte of image data.ππ'8 bit pictures use 1 byte per pixel. Each byte of image dataπ'represents one of 256 colours.ππ'24 bit pictures express colour values by using 3 bytes and each has aπ'value between 0 and 255. The first byte is for red, the second is forπ'green and the third is for blue. Thus (256)^3 or 2^24 of 16777216 differentπ'colours.ππIF bmpinfosize = 12 THENπ   infoheader$ = SPACE$(12)π   GET #1, 15, infoheader$π   nbits = CVI(MID$(infoheader$, 15, 4))ππ   IF nbits = 1 THENπ      palet$ = SPACE$(6)π      GET #1, bmpinfosize + 15, palet$π   ELSEIF nbits = 4 THENπ      palet$ = SPACE$(48)π      GET #1, bmpinfosize + 15, palet$π   ELSEIF nbits = 8 THENπ      palet$ = SPACE$(768)π      GET #1, bmpinfosize + 15, palet$π   END IFπELSEIF bmpinfosize = 40 THENπ   infoheader$ = SPACE$(40)π   GET #1, 15, infoheader$π   nbits = CVI(MID$(infoheader$, 15, 4))π   IF nbits = 1 THENπ      palet$ = SPACE$(8)π      GET #1, bmpinfosize + 15, palet$π   ELSEIF nbits = 4 THENπ      palet$ = SPACE$(64)π      GET #1, bmpinfosize + 15, palet$π   ELSEIF nbits = 8 THENπ      palet$ = SPACE$(1024)π      GET #1, bmpinfosize + 15, palet$π   END IFπEND IFπππft$ = MID$(header$, 1, 2)πPRINT "Type of file (Should be BM): "; ft$ππfilesize = CVL(MID$(header$, 3, 4))πPRINT "Size of file: "; filesizeππr1 = CVI(MID$(header$, 7, 2))πPRINT "Reserved 1: "; r1ππr2 = CVI(MID$(header$, 9, 2))πPRINT "Reserved 2: "; r2ππoffset = CVL(MID$(header$, 11, 4))πPRINT "Number of bytes offset from beginning: "; offsetππPRINTππheadersize& = CVL(MID$(infoheader$, 1, 4))πPRINT "Size of header: "; headersize&ππpicwidth = CVL(MID$(infoheader$, 5, 4))πPRINT "Width: "; picwidthππpicheight = CVL(MID$(infoheader$, 9, 4))πPRINT "Height: "; picheightπnplanes = CVI(MID$(infoheader$, 13, 4))πPRINT "Planes: "; nplanesππPRINT "Bits per plane: "; nbitsππPRINTππIF headersize = 40 THENπ   PRINT "Compression: ";π   comptype = CVL(MID$(infoheader$, 17, 4))π   IF comptype = 0 THEN PRINT "None"π   IF comptype = 1 THEN PRINT "Run Length - 8 Bits"π   IF comptype = 2 THEN PRINT "Run Length - 4 Bits"ππ   imagesize = CVL(MID$(infoheader$, 21, 4))π   PRINT "Image Size (bytes): "; imagesizeππ   xsize = CVL(MID$(infoheader$, 25, 4))π   PRINT "X size (pixels per metre): "; xsizeππ   ysize = CVL(MID$(infoheader$, 29, 4))π   PRINT "Y size (pixels per metre): "; ysizeππ   colorsused = CVL(MID$(infoheader$, 33, 4))π   PRINT "Number of colours used: "; colorsusedππ   neededcolours = CVL(MID$(infoheader$, 37, 4))π   PRINT "Number of important colours: "; neededcoloursπEND IFπPRINTπPRINT "Press Any key to continue."πWHILE INKEY$ = ""πWENDππIF nbits = 1 THENπ   SCREEN 11πELSEIF nbits = 4 THENπ   SCREEN 13πELSEIF nbits = 8 OR nbits = 24 THENπ   SCREEN 13πEND IFπIF bmpinfosize = 40 THEN ngroups = 4πIF bmpinfosize = 12 THEN ngroups = 3ππIF nbits = 24 THENπ   IF ngroups = 3 THENπ      FOR c = 0 TO 63π         d = c * 4π         palet$ = palet$ + CHR$(d) + CHR$(d) + CHR$(d)π         palet$ = palet$ + CHR$(d) + CHR$(d) + CHR$(d + 1)π         palet$ = palet$ + CHR$(d) + CHR$(d + 1) + CHR$(d)π         palet$ = palet$ + CHR$(d + 1) + CHR$(d) + CHR$(d)π      NEXT cπ   ELSEIF ngroups = 4 THENπ      FOR c = 0 TO 63π         d = c * 4π         palet$ = palet$ + CHR$(d) + CHR$(d) + CHR$(d) + CHR$(0)π         palet$ = palet$ + CHR$(d) + CHR$(d) + CHR$(d + 1) + CHR$(0)π         palet$ = palet$ + CHR$(d) + CHR$(d + 1) + CHR$(d) + CHR$(0)π         palet$ = palet$ + CHR$(d + 1) + CHR$(d) + CHR$(d) + CHR$(0)π      NEXT cπ   END IFπEND IFππFOR x = 1 TO LEN(palet$) STEP ngroupsπ   zb# = INT((ASC(MID$(palet$, x, 1))) / 4)π   zg# = INT((ASC(MID$(palet$, x + 1, 1))) / 4)π   zr# = INT((ASC(MID$(palet$, x + 2, 1))) / 4)π   zc# = zb# * 65536# + zg# * 256# + zr#π   cres = ASC(MID$(palet$, x + 3, 1))π   PALETTE ((x - 1) / ngroups), zc#πNEXT xππIF nbits = 24 THENπ   y = picheight - 1π   x = 0π   dat$ = "   "π   WHILE y >= 0π      WHILE x < picwidthπ         GET 1, , dat$π         p1 = INT(ASC(MID$(dat$, 1, 1)) + ASC(MID$(dat$, 1, 1)) + ASC(MID$(dat$, 1, 1)))π         PSET (x, y), p1π         x = x + 1π      WENDπ      y = y - 1π      x = 0π   WENDπELSEIF nbits = 8 THENπ   y = picheight - 1π   x = 0π   dat$ = " "π   WHILE y >= 0π      WHILE x < picwidthπ         GET 1, , dat$π         PSET (x, y), ASC(dat$)π         x = x + 1π      WENDπ      y = y - 1π      x = 0π   WENDπELSEIF nbits = 4 THENπ   y = picheight - 1π   x = 0π   dat$ = " "π   WHILE y >= 0π      WHILE x < picwidthπ        GET 1, , dat$π        LOCATE 1, 1π        p1 = ASC(dat$) AND 15π        p2 = ASC(dat$) AND 240 / 16π        PSET (x, y), p1π        PSET (x + 1, y), p2π        x = x + 2π      WENDπ      y = y - 1π      x = 0π   WENDπELSEIF nbits = 1 THENπ   y = picheight - 1π   x = 0π   dat$ = " "π   WHILE y >= 0π      WHILE x < picwidthπ        GET 1, , dat$π        p1 = ASC(dat$)π        FOR p = 0 TO 7π           PSET (x + (7 - p), y), (p1 AND 2 ^ p) / 2 ^ pπ        NEXT pπ        x = x + 8π      WENDπ      y = y - 1π      x = 0π   WENDπEND IFππCLOSEππThe ABC Programmer             EARTHQUAKE EFFECT DEMO         EARTHQUAKE,EFFECT,DEMO         07-23-94 (00:00)       QB, QBasic, PDS        95   2764     QUAKE.BAS   '==========================================π' EARTHQUAKE by William Yu (07-23-94)π' Creates an Earthquake effectπ' Works on any graphics modeπ' Here's a short demo, modify as you wishπ'==========================================ππDECLARE SUB EarthQuake ()πDIM CRAFT(500)πCLSπSCREEN 12πOUT &H3D4, 9: OUT &H3D5, 1πDOπ  RANDOMIZE TIMERπ  Clock = Clock + 1π  X = INT(RND * 640) + 1π  Y = INT(RND * 280) + 1π  Z = INT(RND * 15) + 1π  PSET (X, Y), ZπLOOP UNTIL Clock = 150πLOCATE 3, 25: COLOR 14: PRINT "JOURNEY TO THE UNKNOWN DIMENSION"πCIRCLE (320, 120), 20, 13, , , 11 / 22πPAINT (320, 120), 13πCIRCLE (315, 122), 2, 6, , , 1 / 3: PAINT (315, 122), 6πCIRCLE (323, 124), 2, 5, , , 1 / 3: PAINT (323, 124), 5πCIRCLE (320, 117), 2, 6, , , 1 / 3: PAINT (320, 117), 6πSLEEP 1πLINE (610, 12)-(630, 4), 10πLINE (610, 12)-(634, 8), 10πLINE (634, 8)-(630, 4), 10πPAINT (630, 6), 10: PSET (617, 10), 10: PSET (616, 10), 10πCIRCLE (628, 7), 2, 9, , , 1 / 3: PAINT (628, 7), 9πLINE (632, 6)-(634, 6), 12: LINE (630, 4)-(632, 4), 12πLINE (634, 8)-(636, 8), 12πGET (639, 2)-(609, 13), CRAFTπX = 609: Y = 2πMOVECRAFT:πX = X - 3πY = Y + 1.1πPUT (X, Y), CRAFT, PSETπIF X = 333 THEN GOTO CRASHπGOTO MOVECRAFTπCRASH:πPSET (330, 115), 10: PSET (330, 115), 12: PSET (325, 116), 15πPSET (330, 114), 15: PSET (329, 113), 12: PSET (326, 115), 10πPSET (331, 115), 10: PSET (331, 115), 12: PSET (325, 113), 10πPSET (332, 114), 15: PSET (327, 113), 10: PSET (329, 114), 10πPSET (330, 113), 10: PSET (328, 112), 10πLINE (333, 114)-(380, 110), 12πLINE (333, 114)-(380, 105), 12πLINE (333, 114)-(380, 100), 12πLINE (333, 114)-(360, 100), 12πLINE (333, 114)-(345, 102), 12πEarthQuakeπLINE (333, 114)-(380, 110), 14πLINE (333, 114)-(380, 105), 14πLINE (333, 114)-(380, 100), 14πLINE (333, 114)-(360, 100), 14πLINE (333, 114)-(345, 102), 14πEarthQuakeπPUT (333, 100), CRAFT, ANDπLINE (333, 114)-(380, 110), 12πLINE (333, 114)-(380, 105), 12πLINE (333, 114)-(380, 100), 12πLINE (333, 114)-(360, 100), 12πLINE (333, 114)-(345, 102), 12πEarthQuakeπLINE (333, 114)-(380, 110), 0πLINE (333, 114)-(380, 105), 0πLINE (333, 114)-(380, 100), 0πLINE (333, 114)-(360, 100), 0πLINE (333, 114)-(345, 102), 0πLINE (341, 105)-(355, 110), 0, BFπEarthQuakeπOUT &H3D4, 8: OUT &H3D5, 0πSLEEP 1πLOCATE 3, 25: PRINT SPACE$(32)πLOCATE 3, 29: COLOR 12: PRINT "WHAT THE HELL WAS THAT!!!"πSLEEP 1πLOCATE 3, 29: COLOR 14: PRINT "HELP! HELP! AHHH...I'M..."πSLEEP 2πLOCATE 3, 29: COLOR 12: PRINT "       NO RESPONSE       "πSLEEP 1πLOCATE 3, 32: PRINT "WHAT HAPPENED TO HIM?"πSLEEP 2ππSUB EarthQuakeππDelay = 5500       ' Increase this or decrease for earthquake delayππFOR X = 1 TO Delayπ  OUT &H3D4, 8: OUT &H3D5, XπNEXT XπEND SUBππMatt Hart                      SAVE/RESTORE GRAPHICS SCREENS  FidoNet QUIK_BAS Echo          07-28-92 (21:55)       QB, PDS                293  9721     GSAVES.BAS  ' MK> Does anyone know how to save the graphics screen for 640x480x16, VGA?π' MK> Also, using a binary file?"BSAVE", not a text file...π'π'π' GSAVES.BAS  by Matt Hartπ' Save/Restore multiple graphics screens inπ' any mode to a single file.π'π' Compile with /AH for huge arrays andπ' /X for error trapping with RESUME NEXTπ'π' The data is stored as follows:π'   1 Byte  :  Monitor Typeπ'   1 Byte  :  Screen Mode (0-13)π'   For VGA monitors, the palette (long integers)π'   is stored next for screens 11, 12, and 13π'    Screen Mode   Number of Bytes   Number of Attributesπ'       11               8                   2π'       12              64                  16π'       13            1024                 256π' π    DEFINT A-Zπ    DECLARE FUNCTION CalcBytes&(X,Y,BPP,P)π    TYPE RegTypeXπ        ax    AS INTEGERπ        bx    AS INTEGERπ        cx    AS INTEGERπ        dx    AS INTEGERπ        bp    AS INTEGERπ        si    AS INTEGERπ        di    AS INTEGERπ        flags AS INTEGERπ        ds    AS INTEGERπ        es    AS INTEGERπ    END TYPEπ    'π    CONST False = 0π    CONST True  = NOT Falseππ    ON ERROR GOTO ErrorTrapπ    'π    REDIM NumBytes&(0 TO 13)π    NumBytes&(0)  = 4000&π    NumBytes&(1)  = CalcBytes&(320,200,2,1)π    NumBytes&(2)  = CalcBytes&(640,200,1,1)π    NumBytes&(3)  = CalcBytes&(720,348,1,1)π    NumBytes&(7)  = CalcBytes&(320,200,1,4)π    NumBytes&(8)  = CalcBytes&(640,200,1,4)π    NumBytes&(9)  = CalcBytes&(640,350,1,4)π    NumBytes&(10) = CalcBytes&(640,350,1,2)π    NumBytes&(11) = CalcBytes&(640,480,1,1)π    NumBytes&(12) = CalcBytes&(640,480,1,4)π    NumBytes&(13) = CalcBytes&(320,200,8,1)π    'π    FileName$ = "SCREENS.BIN"π    ' Example 1 : Screen 0π    CLS : PRINT "This is Screen 0"π    COLOR 14 : PRINT "     This is Screen 0"π    Mon = 0 : ScrMode = 0 : ScreenNum = 1π    CALL SaveScreen(FileName$, Mon, ScrMode, ScreenNum, NumBytes&(),Ecode)π    CLSπ    CALL RestoreScreen(FileName$, ScreenNum, NumBytes&(), Ecode)π    ENDπ    ' Parameters are:π    '     FileName$  =  File to save the screen toπ    '           Mon  =  Monitor Typeπ    '                     0 = Monochrome/Text Onlyπ    '                     1 = Herculesπ    '                     2 = CGAπ    '                     3 = EGAπ    '                     4 = VGAπ    '       ScrMode  =  Current Screen Mode (0-13)π    '     ScreenNum  =  Screen Number to Saveπ    '                   Will return with the last screenπ    '                   number in the file if ScreenNumπ    '                   was greater than the last screen + 1π    '   NumBytes&()  =  Array containing the number of bytesπ    '                   needed to save a screenπ    '         Ecode  =  0 if no error, 1 ifπ    '                   ScreenNum already exists andπ    '                   is not the same ScrMode and Mon,π    '                   or -1 if some other error.π    'πErrorTrap:π    Ecode = Trueπ    RESUME NEXTπ    'πSUB SaveScreen(FileName$, Mon, ScrMode, ScreenNum, NumBytes&(), Ecode)π    Ecode = Falseπ    Buf = FreeFileπ    OPEN "B",Buf,FileName$ : IF Ecode THEN EXIT SUBπ    CurScr = 1  :  CurPos& = 1πDOπ    IF EOF(Buf) THEN EXIT DOπ    M$=" " : S$=" " : GET Buf,,M$ : GET Buf,,S$π    M=ASC(M$) : S=ASC(S$) : CurPos& = CurPos& + 2π    IF CurScr = ScreenNum THENπ        IF M=Mon AND S=ScrMode THENπ            SEEK #Buf, CurPos& - 2π            EXIT DOπ        ELSEπ            Ecode = 1π            EXIT DOπ        ENDIFπ    ELSEπ        IF M=4 THENπ            SELECT CASE Sπ                CASE 11 : CurPos& = CurPos& + 8&π                CASE 12 : CurPos& = CurPos& + 64&π                CASE 13 : CurPos& = CurPos& + 1024&π            END SELECTπ        ENDIFπ        CurPos& = CurPos& + NumBytes&(S)π        SEEK #Buf, CurPos&π        IF Ecode THEN EXIT DO       ' a DOS Errorπ        CurScr = CurScr + 1π    ENDIFπLOOPπ    IF Ecode <> 0 THEN GOTO SS.Endingπ    ScreenNum = CurScrπ    A$=CHR$(Mon)+CHR$(ScrMode) : PUT #Buf,,A$π    IF Ecode THEN GOTO SS.Ending        ' DOS Errorπ    REDIM Saver&(1 TO NumBytes&(ScrMode))π    SaveSeg = VARSEG(Saver&(1))π    SaveAdd& = VARPTR(Saver&(1))π    SELECT CASE ScrModeπ        CASE 0π            FOR P=0 TO 3999π                DEF SEG = &HB000 : Z=PEEK(P)π                DEF SEG = SaveSeg : POKE SaveAdd&+P,Zπ            NEXT Pπ            DEF SEGπ        CASE 1,7,13 : GET (0,0)-(319,199),Saver&π        CASE 2,8    : GET (0,0)-(639,199),Saver&π        CASE 3      : GET (0,0)-(719,347),Saver&π        CASE 9,10   : GET (0,0)-(639,349),Saver&π        CASE 11,12  : GET (0,0)-(639,479),Saver&π    END SELECTπ    IF Ecode THEN GOTO SS.Ending        ' Wrong Screen mode probablyπ    IF Mon = 4 THENπ        SELECT CASE Sπ            CASE 11 : NumPal = 2π            CASE 12 : NumPal = 16π            CASE 13 : NumPal = 256π            CASE ELSE : NumPal = 0π        END SELECTπ        IF NumPal > 0 THENπ            DIM InRegs AS RegTypeXπ            DIM OutRegs AS RegTypeXπ            REDIM PalInfo&(0 TO NumPal-1)π            FOR i = 0 TO NumPal-1π                InRegs.ax = &H1015π                InRegs.bx = iπ                CALL INTERRUPTX (&H10, InRegs, OutRegs)π                A& = (OutRegs.cx AND &HFF00) \ &HFFπ                B& = (OutRegs.cx AND &HFF)π                C& = (OutRegs.dx AND &HFF00) \ &HFFπ                PalInfo&(i) = 65536& * B& + 256& * A& + C&π            NEXT iπ            PSeg = VARSEG(PalInfo&(0)) : PAdd& = VARPTR(PalInfo&(0))π            FOR i = 0 TO NumPal*4-1π                DEF SEG = PSegπ                A$=CHR$(PEEK(PAdd&)) : DEF SEGπ                PUT Buf,,A$π                PAdd& = PAdd& + 1π                IF PAdd& > (16*1024) THENπ                    PAdd& = PAdd& - (16*1024)π                    PSeg = PSeg + (16*1024\64)π                ENDIFπ            NEXTπ        ENDIFπ    ENDIFπ    FOR i=0 TO NumBytes&(ScrMode)-1π        DEF SEG = SaveSegπ        A$=CHR$(PEEK(SaveAdd&)) : DEF SEGπ        PUT Buf,,A$ππ        IF Ecode THEN EXIT FORπ        SaveAdd& = SaveAdd& + 1π        IF SaveAdd& > (16*1024) THENπ            SaveAdd& = SaveAdd& - (16*1024)π            SaveSeg = SaveSeg + (16*1024\64)π        ENDIFπ    NEXT iπ    IF Ecode THEN GOTO SS.Ending        ' DOS Errorπ    CLOSE Bufπ    EXIT SUBπSS.Ending:π    CLOSE BufπEND SUBπππSUB RestoreScreen(FileName$, ScreenNum, NumBytes&(), Ecode)π    Ecode = Falseπ    Buf = FreeFileπ    OPEN "B",Buf,FileName$ : IF Ecode THEN EXIT SUBπ    CurScr = 1  :  CurPos& = 1πDOπ    IF EOF(Buf) THENπ        Ecode = Trueπ        EXIT DOπ    ENDIFπ    M$=" " : S$=" " : GET Buf,,M$ : GET Buf,,S$π    M=ASC(M$) : S=ASC(S$) : CurPos& = CurPos& + 2π    IF CurScr = ScreenNum THENπ        EXIT DOπ    ELSEπ        IF M=4 THENπ            SELECT CASE Sπ                CASE 11 : CurPos& = CurPos& + 8&π                CASE 12 : CurPos& = CurPos& + 64&π                CASE 13 : CurPos& = CurPos& + 1024&π            END SELECTπ        ENDIFπ        CurPos& = CurPos& + NumBytes&(S)π        SEEK #Buf, CurPos&π        IF Ecode THEN EXIT DO       ' a DOS Errorπ    ENDIFπLOOPπ    IF Ecode <> 0 THEN GOTO SS.Endingπ    REDIM Saver&(1 TO NumBytes&(ScrMode))π    SaveSeg = VARSEG(Saver&(1))π    SaveAdd& = VARPTR(Saver&(1))π    G$=" "π    SELECT CASE ScrModeπ        CASE 0π            FOR P=0 TO 3999π                GET Buf,,G$ : Z=ASC(G$)π                DEF SEG = SaveSeg : POKE SaveAdd&+P,Z : DEF SEGπ            NEXT Pπ        CASE 1,7,13 : GET (0,0)-(319,199),Saver&π        CASE 2,8    : GET (0,0)-(639,199),Saver&π        CASE 3      : GET (0,0)-(719,347),Saver&π        CASE 9,10   : GET (0,0)-(639,349),Saver&π        CASE 11,12  : GET (0,0)-(639,479),Saver&π    END SELECTπ    IF Ecode THEN GOTO SS.Ending        ' Wrong Screen mode probablyπ    IF Mon = 4 THENπ        SELECT CASE Sπ            CASE 11 : NumPal = 2π            CASE 12 : NumPal = 16π            CASE 13 : NumPal = 256π            CASE ELSE : NumPal = 0π        END SELECTπ        IF NumPal > 0 THENπ            DIM InRegs AS RegTypeXπ            DIM OutRegs AS RegTypeXπ            REDIM PalInfo&(0 TO NumPal-1)π            FOR i = 0 TO NumPal-1π                InRegs.ax = &H1015π                InRegs.bx = iπ                CALL INTERRUPTX (&H10, InRegs, OutRegs)π                A& = (OutRegs.cx AND &HFF00) \ &HFFπ                B& = (OutRegs.cx AND &HFF)π                C& = (OutRegs.dx AND &HFF00) \ &HFFπ                PalInfo&(i) = 65536& * B& + 256& * A& + C&π            NEXT iπ            PSeg = VARSEG(PalInfo&(0)) : PAdd& = VARPTR(PalInfo&(0))π            FOR i = 0 TO NumPal*4-1π                DEF SEG = PSegπ                A$=CHR$(PEEK(PAdd&)) : DEF SEGπ                PUT Buf,,A$π                PAdd& = PAdd& + 1π                IF PAdd& > (16*1024) THENπ                    PAdd& = PAdd& - (16*1024)π                    PSeg = PSeg + (16*1024\64)ππ                ENDIFπ            NEXTπ        ENDIFπ    ENDIFπ    FOR i=0 TO NumBytes&(ScrMode)-1π        DEF SEG = SaveSegπ        A$=CHR$(PEEK(SaveAdd&)) : DEF SEGπ        PUT Buf,,A$π        IF Ecode THEN EXIT FORπ        SaveAdd& = SaveAdd& + 1π        IF SaveAdd& > (16*1024) THENπ            SaveAdd& = SaveAdd& - (16*1024)π            SaveSeg = SaveSeg + (16*1024\64)π        ENDIFπ    NEXT iπ    IF Ecode THEN GOTO SS.Ending        ' DOS Errorπ    CLOSE Bufπ    EXIT SUBπSS.Ending:π    CLOSE BufπEND SUBππFUNCTION CalcBytes&(X,Y,BPP,P)π    C& = 4+INT(((X)*(BPP)+7)/8)*P*(Y)π    CalcBytes& = C& + C& MOD 4&πEND FUNCTIONπDave Navarro, Jr.              PB GIF DECODER                 FidoNet POWER_BAS Echo         10-21-95 (18:53)       PB                     208  5318     DECGIF.BAS  DEFINT A-ZππDECLARE FUNCTION Getbit ()πDECLARE FUNCTION ReadCode (CodeSize)πDECLARE SUB PlotPixel (A)ππTrue = -1πFalse = 0ππDIM ByteBuffer AS STRING * 1πDIM Powers(8), Prefix(4096), Suffix(4096), Outcode(1024)πDIM MaxCodes(12), Powers2(16)πSHARED Xstart, Xend, True, FalseππFOR A = 1 TO 8: Powers(A) = 2 ^ (A - 1): NEXTπDATA 4,8,16,&h20,&h40,&h80,&h100,&h200,&h400,&h800,&h1000,8192ππFOR A = 0 TO 11: READ MaxCodes(A): NEXTπDATA 1,3,7,15,31,63,127,255ππFOR A = 1 TO 8: READ CodeMask(A): NEXTπDATA 1,2,4,8,16,32,64,128,256,512,1024,2048,4096,8192,16384ππFOR A = 0 TO 14: READ Powers2(A): NEXTππF$="TMP.GIF"ππOPEN F$ FOR BINARY AS #1 LEN = 1πIF LOF(1) = 0 THEN PRINT "File not found!": CLOSE : KILL F$: ENDππFOR A = 1 TO 6π    GET #1, , ByteBuffer: A$ = A$ + ByteBufferπNEXTπIF A$ <> "GIF87a" THENπ    PRINT "Warning, the "; A$; " protocol is being used in this file."π    LINE INPUT "Proceed anyway(Y/N)?"; A$π    IF UCASE$(A$) <> "Y" THEN ENDπEND IFππGET #1, , TotalXπGET #1, , TotalYππPRINT TotalX;"x";TotalY;"x";ππGET #1, , ByteBuffer: A = ASC(ByteBuffer)πBitsPixel = (A AND 7) + 1ππGET #1, , ByteBuffer: Background = ASC(ByteBuffer)πGET #1, , ByteBufferππIF ASC(ByteBuffer) <> 0 THENπ    PRINT "Bad file."π    ENDπEND IFππPRINT 2^BitsPixelππGET$ 1, (2^BitsPixel)*3, Pal$ππFOR I = 1 TO LEN(Pal$)π        Tmp? = ASC(MID$(Pal$,I,1))π        SHIFT RIGHT Tmp?,2π        MID$(Pal$,I,1)=CHR$(Tmp?)πNEXT IππGET #1, , ByteBufferπIF ByteBuffer <> "," THENπ    PRINT "Bad file."π    ENDπEND IFππGET #1, , XstartπGET #1, , YstartπGET #1, , XlengthπGET #1, , YlengthπXend = Xlength + Xstart - 1: Yend = Ylength + Ystart - 1ππGET #1, , ByteBufferπA = ASC(ByteBuffer)πIF (A AND 128) = 128 THENπ    PRINT "Local colormap encountered."π    ENDπELSEIF (A AND 64) = 64 THENπ    PRINT "Image is interlaced!"π    ENDπEND IFππGET #1, , ByteBufferπCodeSize = ASC(ByteBuffer): ClearCode = Powers2(CodeSize)πEOFCode = ClearCode + 1: FirstFree = ClearCode + 2πFreeCode = FirstFree: CodeSize = CodeSize + 1πInitCodeSize = CodeSize: Maxcode = MaxCodes(CodeSize - 2)πBitmask = CodeMask(BitsPixel)ππGET #1, , ByteBufferπBlockLength = ASC(ByteBuffer) + 1: Bitsin = 8πOutCount = 0πX = Xstart: Y = YstartππI$=INPUT$(1)πMode13 1ππREG 1, &H1012πREG 2, 0πREG 3, 256πREG 4, STRPTR(Pal$)πREG 9, STRSEG(Pal$)πCALL INTERRUPT &H10ππDOπ    Code = ReadCode(CodeSize)π    IF Code <> EOFCode THENπ        IF Code = ClearCode THENπ            CodeSize = InitCodeSizeπ            Maxcode = MaxCodes(CodeSize - 2): FreeCode = FirstFreeπ            Code = ReadCode(CodeSize): CurCode = Codeπ            OldCode = Code: FinChar = Code AND Bitmaskπ                                                PlotPixel FinCharπ        ELSEπ            CurCode = Code: InCode = Codeπ            IF Code >= FreeCode THENπ                CurCode = OldCodeπ                Outcode(OutCount) = FinCharπ                OutCount = OutCount + 1π            END IFπ            IF CurCode > Bitmask THENπ                DOπ                    Outcode(OutCount) = Suffix(CurCode)π                    OutCount = OutCount + 1π                    CurCode = Prefix(CurCode)π                LOOP UNTIL CurCode <= Bitmaskπ            END IFπ            FinChar = CurCode AND Bitmaskπ            Outcode(OutCount) = FinCharπ            OutCount = OutCount + 1π            FOR I = OutCount - 1 TO 0 STEP -1π              PlotPixel OutCountπ            NEXTπ            OutCount = 0π            Prefix(FreeCode) = OldCode: Suffix(FreeCode) = FinCharπ            OldCode = InCode: FreeCode = FreeCode + 1π            IF FreeCode >= Maxcode THENπ                IF CodeSize < 12 THENπ                    CodeSize = CodeSize + 1: Maxcode = Maxcode * 2π                END IFπ            END IFπ        END IFπ    END IFπ    A$ = INKEY$πLOOP UNTIL Code = EOFCode OR A$ <> ""πBEEPπIF A$ = "" THEN A$ = INPUT$(1)ππMode13 0πENDπππ'This subprogram gets one bit from the data stream.πFUNCTION Getbit STATICπ    SHARED Powers(), Bitsin, BlockLength, Numπ    DIM ByteBuffer AS SHARED STRING * 1π    Bitsin = Bitsin + 1π    IF Bitsin = 9 THENπ        GET #1, , ByteBufferπ        TempChar = ASC(ByteBuffer)π        Bitsin = 1π        Num = Num + 1π        IF Num = BlockLength THENπ            BlockLength = TempChar + 1π            GET #1, , ByteBufferπ            TempChar = ASC(ByteBuffer)π            Num = 1π        END IFπ    END IFπ    IF (TempChar AND Powers(Bitsin)) = 0 THEN Getbit = 0 ELSE Getbit = 1πEND FUNCTIONππ'This subprogram plots one pixel on the display.πSUB PlotPixel (A) STATICπ                DEF SEG = &HA000π                        POKE Y*320+X, Aπ                DEF SEGπ    X = X + 1π                IF X > Xend THENπ        X = Xstartπ        Y = Y + 1π    END IFπEND SUBππ'This subprogram reads one LZW code from the data stream.ππFUNCTION ReadCode (CodeSize)π    SHARED Powers2()π    Code = 0π    FOR Aa = 0 TO CodeSize - 1π        Code = Code + Getbit * Powers2(Aa)π    NEXTπ    ReadCode = CodeπEND FUNCTIONππSUB Mode13(Bool)π        IF Bool THENπ                REG 1, &H0013π         ELSEπ                REG 1, &H0003π        END IFπ        CALL INTERRUPT &H10πEND SUBπDave Navarro, Jr.              PB PCX DECODER                 FidoNet POWER_BAS Echo         10-21-95 (18:54)       PB                     108  2578     DECPCX.BAS  'Decode PCX filesπ'by Dave Navarro, Jr.ππDEFINT A-ZππTYPE PcxHeaderπ        Mfg    AS BYTEπ        Ver    AS BYTEπ        Enc    AS BYTEπ        Bpp    AS BYTEπ        XMin   AS INTEGERπ        YMin   AS INTEGERπ        XMax   AS INTEGERπ        YMax   AS INTEGERπ        Hres   AS INTEGERπ        Vres   AS INTEGERπ        Pal    AS STRING * 48π        Resrv  AS BYTEπ        ColPl  AS BYTEπ        Bpl    AS INTEGERπ        PalTyp AS INTEGERπ        Filler AS STRING * 58πEND TYPEππDIM Header AS PcxHeaderπDIM ByteBuffer AS BYTEππOPEN "B",1,"TMP.PCX"π         GET# 1,,Headerπ         IF Header.Mfg <> 10 AND Header.Ver <> 5 THENπ                 PRINT "Not a 256 color PCX file!"π                 ENDπ         END IFππ         Tmp& = LOF(1) - 768π         SEEK# 1, Tmp&π         GET$ 1,768,Palete$ππ         FOR I = 1 TO 768π                 Tmp? = ASC(MID$(Palete$,I,1))π                 SHIFT RIGHT Tmp?,2π                 MID$(Palete$,I,1)=CHR$(Tmp?)π         NEXT Iππ         SEEK# 1, 128ππ         Wid = Header.Xmax - Header.Xmin + 1π         Dep = Header.Ymax - Header.Ymin + 1π         Byt = Header.Bplππ         PRINT Wid;"x";Dep;"x";2^Header.Bppππ         I$=INPUT$(1)ππ         Mode13 1ππ         REG 1, &H1012π         REG 2, 0π         REG 3, 256π         REG 4, STRPTR(Palete$)π         REG 9, STRSEG(Palete$)π         CALL INTERRUPT &H10ππ   FOR Y = 0 TO Dep - 1π                 FOR X = 0 TO Byt - 1π                         GET# 1,,ByteBufferπ                         ByteBuffer = ByteBuffer AND &HFFπ                         IF (ByteBuffer AND &HC0) = &HC0 THENπ                                 Times = ByteBuffer AND &H3Fπ                                 GET# 1,,ByteBufferπ                                 FOR I = 1 TO Timesπ                                         PlotPixel ByteBufferπ                                 NEXT Iπ                                ELSEπ                                         PlotPixel ByteBufferπ                         END IFπ                 NEXT Xπ         NEXT YππCLOSE 1ππBEEPπI$=INPUT$(1)πMode13 0πENDπππSUB PlotPixel(Z AS BYTE)π        SHARED Widπ        STATIC X, Yπ        DEF SEG = &HA000π                POKE Y*320+X, Zπ        DEF SEGπ        INCR Xπ        IF X > Wid THENπ                X = 0π                INCR Yπ        END IFπEND SUBππSUB Mode13(Bool)π        IF Bool THENπ                REG 1, &H0013π         ELSEπ                REG 1, &H0003π        END IFπ        CALL INTERRUPT &H10πEND SUBπBrett Levin                    3D CRAFT WITH COLOR            Rich Geldreich                 09-19-92 (00:00)       QB, QBasic, PDS        448  15482    3DCOLOR.BAS 'Well, here you go! This is an improved, easier to read version of myπ'fast 3-D wireframe program. I've done some things that a coupleπ'people recommended and I've also sped it up a little.π'(The number at the upper left corner of the screen is the number ofπ'frames per second that are being displayed. It's updated every 20 frames, soπ'it will be a little choppy.)ππ'3DEXP1b.BAS By Rich Geldreich April 16th, 1992π'π'Modifications by Brett Levin 9/19/92π'π'    I've added another option to the DATA statements that defineπ'  the lines, the last option is the color of that line.  To makeπ'  it easier to change and/or create new objects, there is an addedπ'  data statement near the end that defines the number of lines.π'  I've also fixed some spelling here and there and messed withπ'  the interface.π'    The next thing that I think needs to be done is to add a D3, soπ'  you can control the yaw (?) of the object.  We could use pgup/pgdwnπ'  for this.  If you have any comments/questions, be sure to ask.π'π'    Rich- Be sure to tell me what you think of this.  I'm working on aπ'  addition that will allow...  SCRIPTED ANIMATIONS!!  Cool huh?  Tellπ'  me what you think.π'π'(This version has some documentation...)πDEFINT A-ZππREAD numberlines   ' First DATA statement near end of programπ                   ' WARNING: Make sure you have less than 51 lines!ππTYPE LineTypeπ    X AS INTEGERπ    Y AS INTEGERπ    Z AS INTEGERπ    X1 AS INTEGERπ    Y1 AS INTEGERπ    Z1 AS INTEGERπ    LineColor AS INTEGERπEND TYPEπDIM Points(numberlines) AS LineTypeπDIM Xs(100), Ys(100), Xe(100), Ye(100), Xn(100), Yn(100)πDIM Xs1(100), Ys1(100), Xe1(100), Ye1(100)πDIM X(100), Y(100), Z(100), Pointers1(100), Pointers2(100)πDIM R(100)πDIM Cosine&(360), Sine&(360)πCLSπCOLOR 15πPRINT "3-D Craft v.1b"πPRINT "By Rich Geldreich 1992"πPRINT "(Slight modifications by Brett Levin 9/19/92)": COLOR 7πPRINTπPRINT "Keys to use: (Turn NUMLOCK on!)"πCOLOR 15: PRINT "  General controls": COLOR 7πPRINT "Q...............Quits"πCOLOR 15: PRINT "  View controls": COLOR 7πPRINT "Numeric keypad..Controls your position(press 5 on the keypad"πPRINT "                to completly stop yourself) "πPRINT "-...............Move forward"πPRINT "+...............Move backward"πCOLOR 15: PRINT "  Object controls": COLOR 7πPRINT "Arrow keys......Controls the rotation of the craft"πPRINT "F...............Accelerates the craft (Forward)"πPRINT "B...............Slows the craft (Backward)"πPRINT "S...............Stops the craft"πPRINT "A...............Toggles Auto Center, use this when you lose";πPRINT " the craft"πPRINT "C...............Stops the craft's rotation"πPRINT "V...............Resets the craft to starting position"πPRINTπPRINT "Wait a sec..."ππ'The following for/next loop makes a sine & cosine table.π'Each sine & cosine is multiplied by 1024 and stored as long integers.π'This is done so that we don't have to use any slow floating pointπ'math at run time.πA = 0πFOR A! = 0 TO 359 / 57.29577951# STEP 1 / 57.29577951#π    Cosine&(A) = INT(.5 + COS(A!) * 1024)π    Sine&(A) = INT(.5 + SIN(A!) * 1024): A = A + 1πNEXTππ'Next we read in all of the lines that are in the object...πFOR A = 0 TO numberlines - 1π    READ Points(A).X, Points(A).Y, Points(A).Zπ    READ Points(A).X1, Points(A).Y1, Points(A).Z1π    READ Points(A).LineColorπNEXTπ'Here comes the hard part... Consider this scenario:ππ'We have two connected lines, like this:ππ'   1--------2 and 3π'            |π'            |π'            |π'            |π'            4π'Where 1,2, 3, & 4 are the starting and ending points of each line.π'The first line consists of points 1 & 2  and the second lineπ'is made of points 3 & 4.π'So, you ask, what's wrong? Nothing, really, but don't you see thatπ'points 2 and 3 are really at the sample place? Why rotate them twice,π'that would be a total waste of time? The following code eliminates suchπ'occurrences from the line table. (great explanation, huh?)ππ'take all of the starting & ending points and put them in one bigπ'array...πNp = 0πFOR A = 0 TO numberlines - 1π    X(Np) = Points(A).Xπ    Y(Np) = Points(A).Yπ    Z(Np) = Points(A).Zπ    Np = Np + 1π    X(Np) = Points(A).X1π    Y(Np) = Points(A).Y1π    Z(Np) = Points(A).Z1π    Np = Np + 1πNEXTπ'Now set up two sets of pointers that point to each point that a lineπ'is made of... (in other words, scan for the first occurrence of eachπ'starting and ending point in the point array we just built...)πFOR A = 0 TO numberlines - 1π    Xs = Points(A).Xπ    Ys = Points(A).Yπ    Zs = Points(A).Z            'get the 3 coordinates of the startπ    FOR B = 0 TO Np - 1         'scan the point arrayπ        IF X(B) = Xs AND Y(B) = Ys AND Z(B) = Zs THENπ            Pointers1(A) = B    'set the pointer to point to theπ            EXIT FOR            'point we have just foundπ        END IFπ    NEXTπ    Xs = Points(A).X1           'do the same thing that we did aboveπ    Ys = Points(A).Y1           'except scan for the ending pointπ    Zs = Points(A).Z1           'of each lineπ    FOR B = 0 TO Np - 1π        IF X(B) = Xs AND Y(B) = Ys AND Z(B) = Zs THENπ            Pointers2(A) = Bπ            EXIT FORπ        END IFπ    NEXTπNEXTπ'Okay, were almost done! All we have to do now is to build a tableπ'that tells us which points to actually rotate...πNr = 0πFOR A = 0 TO numberlines - 1π    F1 = Pointers1(A)   'get staring & ending point numberπ    S1 = Pointers2(A)π    IF Nr = 0 THEN      'if this is the first point then it of courseπ                        'has to be rotatedπ        R(Nr) = F1: Nr = Nr + 1π    ELSEπ        Found = 0       'scan to see if this point already exists...π        FOR B = 0 TO Nr - 1π            IF R(B) = F1 THENπ                Found = -1: EXIT FOR    'shoot, it's already here!π            END IFπ        NEXTπ        IF NOT Found THEN R(Nr) = F1: Nr = Nr + 1   'point the pointπ                                                    'in the array it weπ    END IF                                          'can't find it...ππ    Found = 0   'now look for the ending pointπ    FOR B = 0 TO Nr - 1π        IF R(B) = S1 THENπ            Found = -1: EXIT FORπ        END IFπ    NEXTπ    IF NOT Found THEN R(Nr) = S1: Nr = Nr + 1πNEXTπPRINT "Press any key to begin..."πA$ = INPUT$(1)π'The following sets up the rotation & perspective variables.ππ'Vs = the screen that is currently being viewedπ'Ws = the screen that is currently being worked onπVs = 1: Ws = 0ππ'Deg1 & Deg2 are the two angles of rotationπ'D1 & D2 are the deltas of each axes. If D1 = -5, for instance, thenπ'Deg1 will be decreased 5 degress every frame.πDeg1 = 0: Deg2 = 0: D1 = 0: D2 = 0ππ'Spos & Mypos are for the perspective routines...π'Spos is the screen's Z coordinate and Mypos is the users Z coordinateπSpos = -250: Mypos = 0ππ'Mx, My, and Mz are the coordinates of the user.π'Ox, Oy, and Oz are the coordinates of the craft.πMx = 0: my = 0: Mz = 0: Ox = 0: Oy = 0: Oz = -260π'main loopπNumberOfFrames = 0πDEF SEG = &H40πStartTime = PEEK(&H6C)πDOππ    'swap the viewing and working screens for page flipping...π    SWAP Vs, Wsπ    SCREEN 9, , Ws, Vsππ    'adjust the angles according to their deltas...π    Deg1 = (Deg1 + D1) MOD 360π    Deg2 = (Deg2 + D2) MOD 360π    'fix the angles up if they go out of rangeπ    IF Deg1 < 0 THEN Deg1 = Deg1 + 360π    IF Deg2 < 0 THEN Deg2 = Deg2 + 360π    'get the sine and cosine of each angle from the tablesπ    'that were prepared at the beginning of the programπ    C1& = Cosine&(Deg1): S1& = Sine&(Deg1)π    C2& = Cosine&(Deg2): S2& = Sine&(Deg2)ππ    'now we must adjust the object's coordinatesπ    'based on how quickly it is moving...ππ    X = Speed: Y = 0: Z = 0ππ    X1 = (X * C1&) \ 1024: Y1 = (X * S1&) \ 1024π    X2 = (X1 * C2&) \ 1024: Zn = (X1 * S2&) \ 1024π    Ox = Ox + X2: Oy = Oy + Y1: Oz = Oz + Znπ    IF Oz > 32000 THEN Oz = 32000π    IF Oz < -32000 THEN Oz = -32000π    IF Ox > 32000 THEN Ox = 32000π    IF Ox < -32000 THEN Ox = -32000π    IF Oy > 32000 THEN Oy = 32000π    IF Oy < -32000 THEN Oy = -32000ππ    'if Atloc is true then Auto-Center is on...π    IF AtLoc THENπ        Mx = Mx + (Ox - Mx) \ 4π        my = my + (Oy - my) \ 4π        Mz = Mz + ((Oz + 200) - Mz) \ 4π    ELSEπ        'adjust the users position based on how much he is moving...π        Mz = Mz + Mzm: Mx = Mx + Mxm: my = my + Mymπ        IF Mz > 32000 THEN Mz = 32000π        IF Mz < -32000 THEN Mz = -32000π        IF Mx > 32000 THEN Mx = 32000π        IF Mx < -32000 THEN Mx = -32000π        IF my > 32000 THEN my = 32000π        IF my < -32000 THEN my = -32000π    END IFπ    '(Wait for vertical retrace, reduces flicker. This was recommendedπ    'by someone on the echo but I can't remember who! Thanks)π    WAIT &H3DA, 8π    'erase the old lines...π    IF Ws = 1 THENπ        FOR A = 0 TO Ln(Ws) - 1π            LINE (Xs1(A), Ys1(A))-(Xe1(A), Ye1(A)), 0π        NEXTπ    ELSEπ        FOR A = 0 TO Ln(Ws) - 1π            LINE (Xs(A), Ys(A))-(Xe(A), Ye(A)), 0π        NEXTπ    END IFπ    'print frames per secondπ    LOCATE 1, 1: PRINT A$π    'rotate the points...π    FOR A = 0 TO Nr - 1π        R = R(A): Xo = X(R): Yo = Y(R): Zo = Z(R)π        X1 = (Xo * C1& - Yo * S1&) \ 1024π        Y1& = (Xo * S1& + Yo * C1&) \ 1024 - my + Oyπ        X1& = (X1 * C2& - Zo * S2&) \ 1024 - Mx + Oxπ        Zn = (X1 * S2& + Zo * C2&) \ 1024 - Mz + Ozπ        'if the point is too close(or behind) the viewer thenπ        'don't draw it...π        IF (Mypos - Zn) < 15 THENπ            Xn(R) = -1: Yn(R) = 0: Zn = 0π        ELSEπ            'Put the point into perspective...π            'The original formula was:π            'Xnew=Xnew+( -Xold * ( (Spos-Z) / (MPos-Z) ) )π            'Ynew=Ynew=( -Yold * ( (Spos-Z) / (Mpos-Z) ) )π            V = (1330& * (Spos - Zn)) \ (Mypos - Zn)π            Xn(R) = 320 + X1& + (-X1& * V) \ 1330ππ            'The Y coordinate is also multiplied by .8 to adjustπ            'for SCREEN 9's height to width ratio...ππ            Yn(R) = 175 + (8 * (Y1& + (-Y1& * V) \ 1330)) \ 10π        END IFπ    NEXTπ    'draw the lines...π    '(There are two seperate cases, each puts it's coordinatesπ    'in a different array for later erasing. I could of used aπ    '2 dimensional array for this but that is slower.)π    IF Ws = 1 THENπ        Ln = 0π        FOR A = 0 TO numberlines - 1π            F1 = Pointers1(A): S1 = Pointers2(A)π            Xn = Xn(F1): Yn = Yn(F1)π            'if Xn<>-1 then it's in view...π            IF Xn <> -1 THENπ                IF Xn(S1) <> -1 THENπ                    X1 = Xn(S1): Y1 = Yn(S1)π                    LINE (X1, Y1)-(Xn, Yn), Points(A).LineColorπ                    'store the lines so they can be erased later...π                    Xs1(Ln) = X1: Ys1(Ln) = Y1π                    Xe1(Ln) = Xn: Ye1(Ln) = Ynπ                    Ln = Ln + 1π                END IFπ            END IFπ        NEXTπ    ELSEπ        Ln = 0π        FOR A = 0 TO numberlines - 1π            F1 = Pointers1(A): S1 = Pointers2(A)π            Xn = Xn(F1): Yn = Yn(F1)π            'if Xn<>-1 then it's in view...π            IF Xn <> -1 THENπ                IF Xn(S1) <> -1 THENπ                    X1 = Xn(S1): Y1 = Yn(S1)π                    LINE (X1, Y1)-(Xn, Yn), Points(A).LineColorπ                    'store the lines so they can be erased later...π                    Xs(Ln) = X1: Ys(Ln) = Y1π                    Xe(Ln) = Xn: Ye(Ln) = Ynπ                    Ln = Ln + 1π                END IFπ            END IFπ        NEXTπ    END IFπ    Ln(Ws) = Lnπ    K$ = UCASE$(INKEY$)π    'Process the keystroke(if any)...π    IF K$ <> "" THENπ        SELECT CASE K$π            CASE "A"π                AtLoc = NOT AtLocπ            CASE "+"π                Mzm = Mzm + 2π            CASE "-"π                Mzm = Mzm - 2π            CASE "5"π                Mxm = 0: Mym = 0: Mzm = 0π            CASE "4"π                Mxm = Mxm - 2π            CASE "6"π                Mxm = Mxm + 2π            CASE "8"π                Mym = Mym - 2π            CASE "2"π                Mym = Mym + 2π            CASE "F"π                Speed = Speed + 5π            CASE "B"π                Speed = Speed - 5π            CASE "C"π                D1 = 0: D2 = 0π            CASE "S"π                Speed = 0π            CASE CHR$(0) + CHR$(72)π                D1 = D1 + 1π            CASE CHR$(0) + CHR$(80)π                D1 = D1 - 1π            CASE CHR$(0) + CHR$(75)π                D2 = D2 - 1π            CASE CHR$(0) + CHR$(77)π                D2 = D2 + 1π            CASE "Q"π                SCREEN 0, , 0, 0: CLS : PRINT "See ya later!"π                ENDπ            CASE "V"π                D1 = 0: D2 = 0: Deg1 = 0: Deg2 = 0: Speed = 0π        END SELECTπ    END IFπ    NumberOfFrames = NumberOfFrames + 1π    'see if 20 frames have passed; if so then seeπ    'how long it took...π    IF NumberOfFrames = 20 THENπ        TotalTime = PEEK(&H6C) - StartTimeπ        IF TotalTime < 0 THEN TotalTime = TotalTime + 256π        FramesPerSecX100 = 36400 \ TotalTimeπ        High = FramesPerSecX100 \ 100π        Low = FramesPerSecX100 - Highπ        'A$ has the string that is printed at the upper leftπ        'corner of the screenπ        A$ = MID$(STR$(High), 2) + "."π        A$ = A$ + RIGHT$("0" + MID$(STR$(Low), 2), 2) + "  "π        NumberOfFrames = 0π        StartTime = PEEK(&H6C)π    END IFππLOOPππ'This defines the number of lines...πDATA 45π'The following data is the shuttle craft...π'stored as Start X,Y,Z, End X,Y,Z, Line colorππ'  Note: I have added a little description to each section of theπ'   line data to make it easier to experiment around with the colors..π'  Don't ask how long this took me... <G>ππ' topπDATA -157,22,39,-157,-18,39,7πDATA -157,-18,39,-127,-38,39,7πDATA -127,-38,39,113,-38,39,7πDATA 113,-38,39,193,12,39,7π' bottomπDATA 33,42,39,33,42,-56,8πDATA 33,42,-56,-127,42,-56,8πDATA -127,42,-56,-157,22,-56,8πDATA -157,22,-56,-157,22,39,8π' topπDATA -157,22,-56,-157,-18,-56,7πDATA -157,-18,-56,-157,-18,39,7πDATA -157,-18,-56,-127,-38,-56,7πDATA -127,-38,-56,-127,-38,39,7πDATA -127,-38,-56,113,-38,-56,7πDATA 113,-38,-56,113,-38,39,7πDATA 113,-38,-56,193,12,-56,7π' bottomπDATA 193,12,-56,193,12,39,8πDATA -157,22,-56,193,12,-56,8πDATA 193,12,39,-157,22,39,8π' writingπDATA -56,-13,41,-56,-3,41,12πDATA -56,-3,41,-26,-3,41,13πDATA -26,-3,41,-26,7,41,4πDATA -51,7,41,-31,-13,41,5πDATA -11,-13,41,-11,-3,41,5πDATA -11,-3,41,-1,7,41,4πDATA 9,7,41,9,-8,41,13πDATA 9,-8,41,24,-8,41,12π' topπDATA 34,16,41,34,-38,41,7πDATA 33,-39,41,33,-39,-53,7πDATA 33,-39,-53,33,15,-53,7π' hatchπDATA -42,-38,19,-72,-38,19,4πDATA -72,-38,19,-72,-38,-41,4πDATA -72,-38,-41,-42,-38,-41,4πDATA -42,-38,-41,-42,-38,19,4π' bottomπDATA 33,42,39,34,16,41,8    πDATA 33,42,-56,33,15,-53,8  πDATA -157,22,39,-127,42,39,8πDATA -127,42,-56,-127,42,39,8πDATA -127,42,39,33,42,39,8 π' windowπDATA 159,-8,-56,159,-8,40,9 πDATA 143,-18,-56,143,-18,39,9π' bottomπDATA 193,12,39,193,32,30,8  πDATA 33,42,39,193,32,30,8   πDATA 193,32,30,193,32,-47,8 πDATA 33,42,-56,193,32,-47,8 πDATA 193,12,-56,193,32,-47,8ππUnknown Author(s)              EXECUTING ANOTHER PROGRAM      FidoNet QUIK_BAS Echo          09/95 (00:00)          QB, PDS                59   2433     EXEC.BAS    ' > I don't really know how to use interrupts, but I could really useπ' > that. Could you give me some commented code and an explanation of howπ' > to do it?πππ'Load QB /LQB. This includes the routines needed for calling interrupts.π'Second, this will _*NOT*_ work in the IDE! You have to compile it...ππ'$INCLUDE: 'QB.BI'ππDIM Regs AS RegType              ' Whatever it is (Look in that BIπDIM RegsX AS RegTypeX            ' file)ππCLSππ'               INT 21,4B - EXEC/Load and Execute Programπ'        AH = 4Bπ'        AL = 00  to load and execute programπ'           = 01  (Undocumented)  create program segment prefix and loadπ'                 program, but don't execute.  The CS:IP and SS:SP of theπ'                 program is placed in parameter block. Used by debuggersπ'           = 03  load program onlyπ'           = 04  called by MSC spawn() when P_NOWAIT is specifiedπ'        DS:DX = pointer to an ASCIIZ filenameπ'        ES:BX = pointer to a parameter blockππ'Okay. First, we have to load AX with the appropriate values. AX is theπ'accumulator register, and is 16 bits wide. The two 8 bit portions areπ'commonly referred to as AH and AL. (High and Low) Each can obviouslyπ'hold one byte. AX=AH*256+ALππCLSπA$ = "C:\COMMAND.COM" + CHR$(0)        'ASCIIZ = STRING$+&H00π'B$ = "My parameters!! WOW! Command.com will barf on these ones.. <G>"πB$ = ""πRegsX.AX = &H4B00      ' 4b - Select EXEC function from Int 21π                       ' 00 - Just load & run. Don't mess with the otherπ                       '      stuff... Life is too short!πRegsX.DS = VARSEG(A$)  ' DS: Holds Segment of StringπRegsX.DX = SADD(A$)    ' DX: Holds Offset of Stringπ                       ' For reference, 32-bit pointers to ram can beπ                       ' calculated using SEGMENT * 65536 + OFFSETπ                       ' However, since QB, unlike PB, doesn't supportπ                       ' pointers in any form, this is only useful forπ                       ' passing to assembly routines or interruptsπRegsX.ES = VARSEG(B$)  ' Parameters in a string... SegmentπRegsX.BX = SADD(B$)    ' Offset. You should be getting the drill <G>ππPRINT "Calling Int 21h EXEC on "; A$ππCALL INTERRUPTX(&H21, RegsX, RegsX)ππ'        on return:π'        AX = error code if CF set  (see DOS ERROR CODES)πππProgramErrorCode = RegsX.AXπPRINT "Program exited with "; ProgramErrorCodeπENDπDaniel Trimble                 DISABLE CTRL+BREAK             FidoNet QUIK_BAS Echo          Year of 1995           QB, QBasic, PDS        35   1464     NOBREAK.BAS 'QBasic NoBreak v1.0aπ'Copyright (c)1995 by Daniel Trimbleπ'Public Domain - use at your own risk.ππCLSπDOπ   KEY 15, CHR$(4 + 128 + 32 + 64) + CHR$(70)π   ON KEY(15) GOSUB NoBreak: KEY(15) ONπ   KEY 16, CHR$(4 + 128) + CHR$(70): ON KEY(16) GOSUB NoBreak: KEY(16) ONπ   KEY 17, CHR$(4 + 128 + 32) + CHR$(70): ON KEY(17) GOSUB NoBreakπ   KEY(17) ON: KEY 18, CHR$(4 + 128 + 64) + CHR$(70): ON KEY(18) GOSUB NoBreakπ   KEY(18) ON: KEY 19, CHR$(4) + CHR$(70): ON KEY(21) GOSUB NoBreakπ   KEY(21) ON: KEY 22, CHR$(4 + 64) + CHR$(70)π   ON KEY(22) GOSUB NoBreak: KEY(22) ON: KEY 23, CHR$(4 + 32) + CHR$(46)π   ON KEY(23) GOSUB NoBreak: KEY(23) ON: KEY 24, CHR$(4 + 64) + CHR$(46)π   ON KEY(24) GOSUB NoBreak: KEY(24) ONπ   KEY 25, CHR$(4 + 32 + 64) + CHR$(46): ON KEY(25) GOSUB NoBreak: KEY(25) ONππ   LOCATE 1, 1, 0: PRINT "QBasic NoBreak v1.0a"π   LOCATE 2, 1, 0: PRINT "Copyright (c)1995 by Daniel Trimble"π   LOCATE 4, 1, 0: PRINT "This program and all source is public domain.  I will not be responsible"π   LOCATE 5, 1, 0: PRINT "for any damage this program may cause.  I am not at fault.  Use at your"π   LOCATE 6, 1, 0: PRINT "own risk - period!"π   LOCATE 15, 1, 0: PRINT "Try pressing either CTRL-BREAK or CTRL-C.  Nothing will happen."π   LOCATE 16, 1, 0: PRINT "To end the program, hit ENTER."π   IF INKEY$ = CHR$(13) THEN ENDπLOOPππNoBreak: RETURNπππ'ctrl =4          extended keys=128π'num lock=32      c=46π'cap lock=64ππUnknown Author(s)              SET CURSOR TYPEMATIC KEYRATE   FidoNet QUIK_BAS Echo          Unknown Date           QB, PDS                16   470      KEYSPEED.BAS'$INCLUDE: 'QBX.BI' or QB.BIππSUB KeySpeed (rate, delay)π π'Sets the cursor typematic keyrate.  Rate is the speed at whichπ'the keys repeat, the range is from 0 to 31, 0 being fastest.π'Delay is the amount of time in 250 millisecond parts before theπ'keys begin to repeat.  The range is from 0 to 3, 0 being theπ'shortest wait.π πDIM Regs AS RegTypeπRegs.ax = &H305πRegs.bx = (delay AND 3) * 256 + (rate AND 31)πCALL Interrupt(&H16, Regs, Regs)πEND SUBππChristy Gemmell                STUFF KEYBOARD BUFFER          Ethan Winer                    06-01-95 (13:01)       QB, QBasic, PDS        141  5579     KEYBUFF.BAS ' >> I've been trying to use an example program from Ethan Winer'sπ'  >> "Basic Tips and Tricks". I have successfully used other programsπ'  >> of his, but I cannot get this example to work for love nor money..ππ' >> ------------------------ ethan winers Stuff Buffer example--------π'  >> SUB StuffBuffer (Cmd$) STATICπ'  >>π'  >>   '----- Limit the string to 14 characters plus Enter and saveπ'  >>   '      the length.π'  >>   Work$ = LEFT$(Cmd$, 14) + CHR$(13)π'  >>   Length = LEN(Work$)π'  >>π'  >>   '----- Set the segment for poking, define the buffer head and tail,π'  >>   '      and then poke each character.π'  >>   DEF SEG = 0π'  >>   POKE 1050, 30π'  >>   POKE 1052, 30 + Length * 2π'  >>   FOR X = 1 TO Lengthπ'  >>     POKE 1052 + X * 2, ASC(MID$(Work$, X))π'  >>   NEXTπ'  >>π'  >> END SUBππ'There's nothing wrong with Ethan's code and the POKE addresses are theπ'default ones for the keyboard buffer. However not all computers haveπ'the buffer in the usual place and if, for example, you have a keyboardπ'enhancer program that gives you a larger typeahead buffer then it mightπ'have been moved elsewhere.ππ'As a quick check try running this little program...ππ'    DEF SEG = &H40π'    X& = PEEK(&H80) + (256& * PEEK(&H81))π'    PRINT X&ππ'If your keyboard buffer is in the standard place then X& should be equalπ'to thirty. If you get any other value than 30 your buffer has definitelyπ'been moved since the two bytes at 0040:0080 are a pointer to the start ofπ'the keyboard buffer taken as an offset from segment 0040 (Hex) - the BIOSπ'DATA area.ππ'Personally I would rewrite the second part of Ethan's procedure asπ'follows:ππ'    DEF SEG = &H40                      ' Switch to BIOS data segmentπ'    Head% = &H1A                        ' Buffer head pointerπ'    Tail% = &H1C                        ' Buffer tail pointerπ'    Start& = PEEK(&H80) + (256& * PEEK(&H81))π                                        ' Pointer to keyboard bufferπ'    FOR X = 1 TO Length                 ' Stuff the bufferπ'        POKE Start& + (X - 1) * 2, ASC(MID$(work$, X, 1))π'    NEXTπ'    POKE Head%, Start&                  ' Set new head pointerπ'    POKE Tail%, Start& + (X - 1) * 2    ' Set new tail pointerππ'This should work wherever the buffer is located.ππ'If you want to see how the keyboard buffer works, try running theπ'program below. It displays the contents in real time so you canπ'watch as each keypress is inserted.ππ'--- cut here ---------------------------------------------------------------π' KEYBUFF.BAS   continuously displays contents of keyboard bufferπ'π'   Author:     Christy Gemmellπ'   Date:       19/2/1990π'π    COLOR 15, 0: CLS : LOCATE , , 0π    READ Items%π    FOR I% = 1 TO Items%π        READ Row%, Col%, Text$π        LOCATE Row%, Col%: PRINT Text$;π    NEXT I%π    LOCATE 11, 68: COLOR 11π    DEF SEG = &H40π    Start& = &H400 + PEEK(&H80): Finish& = &H400 + PEEK(&H82)π    PRINT RIGHT$("0000" + HEX$(Start&), 4); " ";π    PRINT RIGHT$("0000" + HEX$(Finish&), 4);π    IF Start& <> &H41E THENπ       S& = Start& - &H400: Ix$ = ""π       FOR I% = 0 TO 15π           Ix$ = Ix$ + RIGHT$("0" + HEX$(S& + (I% * 2)), 2) + " "π       NEXT I%π       LOCATE 8, 17: COLOR 15: PRINT RTRIM$(Ix$);π    END IFπ    DOπ       LOCATE 11, 4: COLOR 11π       Head& = &H400 + PEEK(&H1A): Tail& = &H400 + PEEK(&H1C)π       PRINT RIGHT$("0000" + HEX$(Head&), 4); " ";π       PRINT RIGHT$("0000" + HEX$(Tail&), 4);π       COLOR 13: LOCATE 9, 17: PRINT SPACE$(48);π       LOCATE 9, 17 + ((Head& - &H41E) \ 2) * 3: PRINT CHR$(25);π       COLOR 12: LOCATE 13, 17: PRINT SPACE$(48);π       LOCATE 13, 17 + ((Tail& - &H41E) \ 2) * 3: PRINT CHR$(24);π       FOR I% = 0 TO 15π           Character% = PEEK((Start& - &H400) + (I% * 2))π           Scancode% = PEEK((Start& - &H400) + (I% * 2) + 1)π           IF Character% < 32 THENπ              Ky$ = "  "π           ELSEπ              Ky$ = CHR$(Character%) + " "π           END IFπ           LOCATE 11, 17 + (I% * 3): COLOR 14: PRINT Ky$;π           LOCATE 14, 17 + (I% * 3): COLOR 9π           PRINT RIGHT$("0" + HEX$(Character%), 2);π           LOCATE 15, 17 + (I% * 3): COLOR 10π           PRINT RIGHT$("0" + HEX$(Scancode%), 2);π'(Continued to next message)π'(Continued from previous message)π       NEXT I%π       IF Head& >= Tail& THENπ          Numkeys% = 16 - ((Head& - Tail&) \ 2)π       ELSEπ          Numkeys% = (Tail& - Head&) \ 2π       END IFπ       LOCATE 14, 76: IF Numkeys% = 16 THEN Numkeys% = 0π       PRINT RIGHT$(" " + LTRIM$(RTRIM$(STR$(Numkeys%))), 2);π       IF Numkeys% = 15 THENπ          LOCATE 15, 67: COLOR 28: PRINT "BUFFER FULL";π          Dummy$ = INPUT$(16)π          LOCATE , 67: PRINT SPACE$(11);π       END IFπ    LOOP UNTIL PEEK((Tail& - &H400) - 2) = 27π    DEF SEG : COLOR 7, 0: LOCATE 20, 1, 1π    Dummy$ = INPUT$(Numkeys%)πENDππDATA  20πDATA  6, 4, "Head Tail", 6, 33, "Keyboard buffer"πDATA  6, 67, "Buffer Area", 8, 4, "041A 041C"πDATA  8, 17, "1E 20 22 24 26 28 2A 2C 2E 30 32 34 36 38 3A 3C"πDATA  8, 68, "0480 0482", 10, 3, "-----|-----"πDATA  10, 16, "|--|--|--|--|--|--|--|--|--|--|--|--|--|--|--|--|"πDATA  10, 67, "-----|-----", 11, 3, "           ", 11, 16, " "πDATA  11, 64, " ", 11, 67, "           ", 12, 3, "-----|-----"πDATA  12, 16, "|--|--|--|--|--|--|--|--|--|--|--|--|--|--|--|--|"πDATA  12, 67, "-----|-----", 14, 3, "ASCII Codes"πDATA  14, 67, "Waiting", 15, 3, "Scan Codes"πDATA  24, 31, "Press <Esc> to quit"πππPeter Norton                   RETURNS KEY(S) PRESSED         Advanced BASIC Book            Unknown Date           QB, PDS                52   1317     INKEY.BAS   ' Returns the key(s) pressedπ' Useful to find value of combined keysπ' ie.  CTRL+UP     =  CHR$(0)+CHR$(141)π'      CTRL+DOWN   =  CHR$(0)+CHR$(145)ππDECLARE FUNCTION InKeyNoEcho$ ()πTYPE RegTypeπ        ax      AS INTEGERπ        bx      AS INTEGERπ        cx      AS INTEGERπ        dx      AS INTEGERπ        bp      AS INTEGERπ        si      AS INTEGERπ        di      AS INTEGERπ        flags   AS INTEGERπEND TYPEππDECLARE SUB INTERRUPT (IntNo AS INTEGER, InRegs AS RegType, OutRegs AS RegType)ππ        PRINT "Type a character: "π        DOπ        TheKey$ = InKeyNoEcho$π        LOOP WHILE TheKey$ = ""π        PRINT "That character was: ", TheKey$ππENDππFUNCTION InKeyNoEcho$ππ   DIM InRegs AS RegType, OutRegs AS RegTypeπ   InRegs.ax = &H600π   InRegs.dx = &HFFππ   CALL INTERRUPT(&H21, InRegs, OutRegs)ππ   REM No character ready if zero flag setππ   IF (OutRegs.flags AND 2 ^ 6) THENπ       InKeyNoEcho$ = ""π   ELSEπ       IF (OutRegs.ax AND &HFF) <> 0 THENπ           InKeyNoEcho$ = CHR$(OutRegs.ax AND &HFF)π       ELSE    'Need one more callπ           InRegs.ax = &H600π           InRegs.dx = &HFFπ           CALL INTERRUPT(&H21, InRegs, OutRegs)π           InKeyNoEcho$ = CHR$(0) + CHR$(OutRegs.ax AND &HFF)π      END IFπ   END IFππEND FUNCTIONππUnknown Author(s)              DISABLE/ENABLE KEYBOARD        QBFAQ                          Unknown Date           QB, QBasic, PDS        17   340      DISKEYB.BAS SUB DisableKeyboard ()π   π   'Purpose : To disable the keyboardπ   'Input   : noneπ   'Return  : noneππ   OUT &H21, (INP(&H21) OR 2)πEND SUBππSUB EnableKeyboard ()ππ   'Purpose : To enable keyboard use after being disabled by DisableKeyboardπ   'Input   : noneπ   'Output  : noneππ   OUT &H21, (INP(&H21) AND 253)πEND SUBπDISABLE PAUSE BUTTON           EDWARD LAM/BRENT ASHLEY        NANET-BASIC                    02-01-93               ASM, QB, PDS           127  4174     NOPAUSE.BAS '   Because B_OnExit might have too many routines registered already, I've madeπ'NoPause a function returning TRUE(-1) if everything is ok, otherwise FALSE(0).π'   The B_OnExit routine does look a little eratic to me in the environment butπ'try it and see what happens.ππ'cut here for NOPDEMO2.BASππ'Example program for NoPause2 module.π'πDECLARE FUNCTION NoPause%π'πCLSπPRINT "Press N for NoPause, U to Unhook NoPause, ESC to exit"πDOπ  I = (I + 1) MOD 1000π  LOCATE 5, 5: PRINT "     ";π  LOCATE 5, 5: PRINT I;π  A$ = UCASE$(INKEY$)π  IF A$ = "N" THENπ     IF NOT NoPause% THEN   'We call NoPause hereπ        LOCATE 2, 1π        PRINT "B_OnExit Full!  Can't stop pause key"π     END IFπ  END IFπ  IF A$ = "U" THENπ      CALL UnhookNoPause  'Have option to disable nopause fromπ                           'within programπ      LOCATE 2, 1π      PRINT SPACE$(36)π  END IFπLOOP UNTIL A$ = CHR$(27)π'Note that we don't care the state of the vectors since B_OnExit will callπ'UnHookNoPause for us.  You can call UnHookExit as many times as you likeππ ;NoPause2.ASMππ;Note that this file has been modified so that the UnHookNoPause routineπ;does not need ever (or should it) to be called.  --EKLππEXTRN   B_OnExit:FAR            ;QB's internal routine calls all cleanπ                                ;up routines registered with it onyπ_any_ exitππ;π; NoPause.ASM by Brent Ashley  /  NoPause2.ASM modified by Edward Lam 01/31/93π;π.model medium, basicπ.codeπOld1C        Label Dword          ;Label for to old Int 1ChπOld1COffset  dw ?                 ;Offset partπOld1CSegment dw ?                 ;Segment partπHooked       db 0                 ;Our installed flagππ;Note that if an error occurs registering NoHookPause, NoPause will returnπ;FALSE.  Right, it's a function now instead of a sub -- EKLπNoPause proc uses ds dx           ;From BASIC: Ok% = NoPause%π                                  ;Use UnhookNoPause to disable NoPauseππ        cmp cs:Hooked,0           ;Are we already hooked?π        jnz InstallExit           ;If so, exitππ        ;following section just cut&paste from EVENTCHN.ASM by Jim Mackπ        mov     dx, offset UnHookNoPauseπ        push    cs                ; push far address of UnHookNoPauseπ        push    dx                ; to register the exit routineπ        call    B_OnExit          ; so that we don't hang machineπ        or      ax, ax            ; registered OK?π        jz      ErrorExit         ; error: too many registered routinesππ        mov ax,351Ch              ;Get current vector for int 09hπ        int 21hππ        mov cs:Old1CSegment,es    ;Remember it for laterπ        mov cs:Old1COffset,bxπ        mov ax,251Chπ        push dsπ        push csπ        pop ds                    ;Point int 1Ch to our codeπ        mov dx, offset OurInt1Cπ        int 21hπ        pop dsπ        mov cs:Hooked,-1          ;Set our installed flagπ        mov ax, -1                ;return TRUE for okπ        jmp InstallExitππErrorExit:π        sub ax, ax                ;put 0 into ax to return with errorππInstallExit:π        retππOurInt1C:                         ;Our Int 1Ch handlerπ        push ds                   ;π        push bxπ        push axπ        xor bx, bx                ;point DS to BIOS data areaπ        mov ds, bx                ;π        mov bx, 0418hπ        mov al, [bx]π        and al, 0F7h              ;reset nopause flagπ        mov [bx], alπ        pop axπ        pop bxπ        pop dsπ        jmp dword ptr cs:[Old1C]  ;Transfer to orig Int 1ChππNoPause endpππUnhookNoPause proc                ; from BASIC: CALL UnHookNoPauseπ        cmp cs:Hooked,0           ; are we installed?π        jz UnHooked               ; nope - exitππ        push axπ        push dsπ        mov ax,251Ch              ;Unhook ourselfπ        mov ds,Old1CSegmentπ        mov dx,Old1COffsetπ        int 21h                   ;Point Int 1Ch back to originalπ        pop dsπ        pop axπ        mov cs:Hooked,0           ;Set installed flag back to zeroππUnHooked:π        retπUnhookNoPause endpππENDπJames Vahn                     CHECK FOR EMS                  FidoNet QUIK_BAS Echo          Unknown Date           QB, PDS                61   2088     EMSCHECK.BAS'test4ems.bas  -  James Vahn 1:30854/20@fidonetπ'written for QB 4.5  Load QB/L - does not work with Qbasic.π'$INCLUDE: 'qb.bi'π π'This checks out your EMS driver & hardware.π πTYPE EmsHardwareπ        EmmRawPageSize                  AS INTEGERπ        NumberAlternateRegisterSets     AS INTEGERπ        SizeMappingContextSaveArea      AS INTEGERπ        NumberDMARegisterSets           AS INTEGERπ        DMAOperationType                AS INTEGERπEND TYPEπ πDIM Regs AS RegTypeXπDIM EmsH AS EmsHardwareπ πRegs.ax = &H3567                 ' locate code for INT 67, EMS driver.πCALL INTERRUPTX(&H21, Regs, Regs)πDEF SEG = Regs.esπ    FOR t = &HA TO &H11          ' search the driver header for textπ    EMS$ = EMS$ + CHR$(PEEK(t))π    NEXTπIF EMS$ = "EMMQXXX0" THENπ    EMS$ = "EMMXXXX0"π    PRINT "DR DOS EMM386 detected."π    PRINT "Would you like it fixed (y/n)?"π          WHILE A$ = ""π          A$ = INKEY$π          WENDπ          IF A$ = "y" THENπ          POKE &HA + 3, ASC("X")    ' fix(?) the driver handle.π          END IFπEND IFπDEF SEGπIF EMS$ <> "EMMXXXX0" THEN PRINT "No EMS installed": ENDπ πPRINT "EMS Driver found at "; HEX$(Regs.es); ":"; HEX$(Regs.bx)πRegs.ax = &H5900        ' subfunction 59hπRegs.es = VARSEG(EmsH)  ' point ES:DI to the array EmsHπRegs.di = VARPTR(EmsH)  'πCALL INTERRUPTX(&H67, Regs, Regs)π πPRINT "Emm Raw Page Size"; EmsH.EmmRawPageSizeπPRINT "Number Alternate Register Sets"; EmsH.NumberAlternateRegisterSetsπPRINT "Size Mapping Context Save Area"; EmsH.SizeMappingContextSaveAreaπPRINT "Number DMA Register Sets"; EmsH.NumberDMARegisterSetsπPRINT "DMA Operation Type"; EmsH.DMAOperationTypeπ πRegs.ax = &H4200πCALL INTERRUPTX(&H67, Regs, Regs)π πPRINT "Total EMS memory"; Regs.dx * 16; CHR$(29) + "k"πPRINT "Total EMS memory available"; Regs.bx * 16; CHR$(29) + "k"πPRINTπ IF EmsH.NumberAlternateRegisterSets = 0 THENπ        PRINT "Hardware alternate page mapping not supported."π        PRINT " Bad news for multitasking."π ELSEπ        PRINT "Suitable for multitasking."π END IFπUnknown Author(s)              EXPANDED MEMORY ROUTINES       QB TidBits                     Unknown Date           QB, PDS                333  9495     EMM.BAS     'Program to store data in Expanded memory with QuickBasic.ππDECLARE SUB CallEmm (EmmFuncNbr%)πDECLARE FUNCTION EmmDriverExists2% ()πDECLARE FUNCTION EmmDriverExists1% ()πDECLARE SUB EmmPrintStatus (Status%)πDECLARE FUNCTION FmtPointer$ (P AS ANY)πDECLARE FUNCTION Hi% (Operand%)πDECLARE FUNCTION Lo% (Operand%)ππ'If you use the PDS product, change the next line to includeπ'the QBX.BI include file instead of the QB.BI fileππ'$INCLUDE: 'QB.BI'ππDEFINT A-ZππCONST EmsInt = &H67         'EMS interrupt numberπCONST IoCtlFunc = &H44      'IOCtl DOS Function numberπCONST PageLen = 16384       'Length of memory pageπCONST MsgLen = 16           'Message lengthπCONST MsgsPerPage = PageLen \ MsgLenπCONST NumMsgs = 5000ππ'*** Emm functions ***ππCONST GetStatus = &H40πCONST GetPageFrameAddr = &H41πCONST GetUnallocPages = &H42πCONST GetEmmVersion = &H46πCONST AllocatePages = &H43πCONST MapHandlePage = &H44πCONST DeallocatePages = &H45ππCLSππTYPE addressπ    Segment AS LONGπ    Offset AS LONGπEND TYPEππDIM P0 AS address             'Pointer to physical page 1πDIM P1 AS address             'Pointer to physical page 2πDIM P2 AS address             'Pointer to physical page 3πDIM P3 AS address             'Pointer to physical page 4πDIM MsgBuf AS address         'Pointer into mapped memoryπDIM Buff AS STRING * 16       'Buffer for message to store in EMπDIM I AS INTEGER              'Dummy variableπDIM SHARED EmmRegs AS RegType 'Registers for interrupt callsπDIM Page AS LONG              'Page frame addressπDIM Index AS LONG             'Index into page frameπDIM StrNum AS STRING * 6      'Holds record # for EMM msgππ'Test for the existence of the EMM driverπ'You can choose from 1 of 2 methodsππ'IF EmmDriverExists1% THEN         'Method 1πIF EmmDriverExists2% THEN          'Method 2π    PRINT "EMM driver exists"πELSEπ    PRINT "No EMM driver detected."πEND IFππ'Print the current status of the EMM driverππPRINT "Checking EMM status"πCALL CallEmm(GetStatus)πPRINT "EMM status ok"ππ'Print the version number of the EMM driverππCALL CallEmm(GetEmmVersion)ππPRINT "EMS driver version = ";ππAL% = Lo%(EmmRegs.ax)πMajorVersion = AL% \ 16πMinorVersion = AL% AND &HFπPRINT USING "!."; RIGHT$(STR$(MajorVersion), 1);πPRINT USING "!"; RIGHT$(STR$(MinorVersion), 1)ππIF AL% < &H32 THENπ    PRINT "Error - EMM version is earlier than 3.2"π    SYSTEMπEND IFππ'***** Print the page frame & physical window addresses *****ππCALL CallEmm(GetPageFrameAddr)ππP0.Segment = EmmRegs.bx   'Window 0 -> P0 = BX:0000πP1.Segment = EmmRegs.bx   'Window 1 -> P1 = BX:4000πP2.Segment = EmmRegs.bx   'Window 2 -> P2 = BX:8000πP3.Segment = EmmRegs.bx   'Window 3 -> P3 = BX:C000πP0.Offset = &H0πP1.Offset = &H4000πP2.Offset = &H8000πP3.Offset = &HC000ππPRINT "Page frame segment address = "; HEX$(EmmRegs.bx)πPRINT "Physical page 0 address = "; FmtPointer$(P0)πPRINT "Physical page 1 address = "; FmtPointer$(P1)πPRINT "Physical page 2 address = "; FmtPointer$(P2)πPRINT "Physical page 3 address = "; FmtPointer$(P3)ππ'***** Print # of unallocated pages and total # of pages *****ππCALL CallEmm(GetUnallocPages)πPRINT "Total EMS pages = "; EmmRegs.dxπPRINT "Unused EMS pages = "; EmmRegs.bxππ'***** Allocate some pages of expanded memory *****ππEmmRegs.bx = (NumMsgs + MsgsPerPage) \ MsgsPerPageπCALL CallEmm(AllocatePages)πPRINT "Allocated "; EmmRegs.bx; " pages to handle #"; EmmRegs.dxπEmmHandle = EmmRegs.dxππ'***** Load EMS RAM with data *****ππMsgBuf = P0πPRINT "Storing messages into extended memory page frame"πLastPageNbr = -1πFOR I = 0 TO NumMsgs - 1π    LOCATE 14, 50: PRINT USING "#,###"; Iπ    StrNum = STR$(I)π    Buff = " EMS msg #" + StrNumπ    Page = I \ MsgsPerPageπ    Index = I MOD MsgsPerPageπ    MsgBuf.Offset = Index * LEN(Buff)ππ    '***** Map indicated logical page into physical page 0 ****ππ    IF Page <> LastPageNbr THENπ        AH = MapHandlePageπ        AL = 0π        EmmRegs.ax = AH * 256 + AL  'Map EMS page & Physical page 0π        EmmRegs.bx = Pageπ        EmmRegs.dx = EmmHandle                      'EMM RAM handleπ        CALL INTERRUPT(EmsInt, EmmRegs, EmmRegs)π        LastPageNbr = Pageπ    END IFππ    AH = Hi%(EmmRegs.ax)π    IF AH = 0 THENππ        ' Set message into memoryππ        DEF SEG = MsgBuf.Segmentπ        FOR J = 0 TO MsgLen - 1π            POKE MsgBuf.Offset + J, ASC(MID$(Buff, J + 1, 1))π        NEXT Jπ        DEF SEGππ    ELSEπ        CALL EmmPrintStatus(AH)π        EXIT FORπ    END IFπNEXT IππPRINTππ'Allow user to access any message in the bufferππI = &HFFππWHILE I <> -1π    INPUT "Enter message # to retrieve, or -1 to quit: "; Iπ    IF (I >= 0) AND (I < NumMsgs) THENππ        MsgBuf = P3π        Page = I \ MsgsPerPageπ        Index = I MOD MsgsPerPageπ        π'***** Map indicated page into physical page 3 *****ππ        AH = MapHandlePage                 'Map EMM pageπ        AL = 3                             ' using physical page 3π        EmmRegs.ax = AH * 256 + ALπ        EmmRegs.bx = Page                  'Logical page numberπ        EmmRegs.dx = EmmHandle             'EMM RAM handleππ        CALL INTERRUPT(EmsInt, EmmRegs, EmmRegs)π        AH = Hi%(EmmRegs.ax)π        IF AH = 0 THENπ            MsgBuf.Offset = MsgBuf.Offset + Index * LEN(Buff)ππ            'Move the bytes from memory to a local variableππ            DEF SEG = MsgBuf.Segmentπ            FOR J = 0 TO MsgLen - 1π                MID$(Buff, J + 1, 1) = CHR$(PEEK(MsgBuf.Offset + J))π            NEXT Jπ            DEF SEGππ            PRINT "Retrieved message -> "; Buff;π            PRINT " from page #"; Page; " Index"; Indexπ        ELSEπ            CALL EmmPrintStatus(AH)π            I = -1π        END IFπ    END IFππWENDππ'***** Free the EMS RAM back to the EMM driver *****ππEmmRegs.dx = EmmHandleπCALL CallEmm(DeallocatePages)πPRINT "Released all memory for handle "; EmmRegs.dxπENDππ'Error handling routineππoops:π    SELECT CASE ERRπ        CASE 53   'File/device not found.π            PRINT "No EMM driver found"π            SYSTEMπ        CASE ELSEπ            PRINT "Unknown error #"; ERRπ            SYSTEMπ    END SELECTππSUB CallEmm (EmmFuncNbr)ππ    EmmRegs.ax = EmmFuncNbr * 256π    CALL INTERRUPT(EmsInt, EmmRegs, EmmRegs)π    AH = Hi%(EmmRegs.ax)π    IF AH <> 0 THENπ        CALL EmmPrintStatus(AH)π        SYSTEMπ    END IFππEND SUBππFUNCTION EmmDriverExists1%ππDIM EmsDriver AS addressπDIM EmsIdString AS STRING * 8ππEmmDriverExists1% = 0                   'FalseπDEF SEG = 0πVectorAddr = &H67 * 4πEmsDriver.Segment = PEEK(VectorAddr + 3) * 256& + _π                    PEEK(VectorAddr + 2)ππIF EmsDriver.Segment <> 0 THENπ    DEF SEG = EmsDriver.Segmentπ    EmsDriver.Offset = 10π    FOR I = 0 TO 7π     MID$(EmsIdString, I + 1, 1) = CHR$(PEEK(EmsDriver.Offset + I))π    NEXT Iπ    IF EmsIdString = "EMMXXXX0" THENπ     EmmDriverExists1% = -1π    END IFπEND IFπDEF SEGππEND FUNCTIONππFUNCTION EmmDriverExists2%ππDIM EmmHandle AS INTEGER      'Handle for EMM allocated pagesππON ERROR GOTO oopsπ    EmmDriverExists2% = -1      'Set default return value to TRUEπ    OPEN "I", 1, "EMMXXXX0"ππ    EmmRegs.ax = IoCtlFunc * 256&           'Call IOCtl Functionπ    EmmRegs.bx = FILEATTR(1, 2)             'Set DOS file handle#π    CALL INTERRUPT(&H21, EmmRegs, EmmRegs)  'Call DOSπ    CLOSE 1π    IF (EmmRegs.flags AND 1) = 0 THEN       'Call successfullπ     IF (EmmRegs.dx AND &H80) = &H80 THEN  'Handle is for a devπ        PRINT "Handle refers to a device"π     ELSEπ        PRINT "Handle refers to a file"π        PRINT "Unable to contact EMM driver if present"π        SYSTEMπ     END IFπ    ELSE 'Call unsuccessfullπ     SELECT CASE EmmRegs.axπ        CASE 1: PRINT "Invalid IOCtl subfunction"π        CASE 5: PRINT "Access to IOCTL denied"π        CASE 6: PRINT "Invalid handle"π        CASE ELSEπ            PRINT "Unknown error # "; EmmRegs.axπ     END SELECTπ     PRINT "Unable to contact EMM driver"π     SYSTEMπ    END IFπ    EXIT FUNCTIONππEND FUNCTIONππSUB EmmPrintStatus (Status%)π    SELECT CASE Status%π        CASE &H0: S$ = "Status ok"π        CASE &H80: S$ = "Driver malfunction"π        CASE &H81: S$ = "Hardware malfunction"π        CASE &H83: S$ = "Bad Handle"π        CASE &H84: S$ = "Undefined function"π        CASE &H85: S$ = "No free handles"π        CASE &H86: S$ = "Page map context error"π        CASE &H87: S$ = "Insufficient memory pages"π        CASE &H88: S$ = "Not enough free pages"π        CASE &H89: S$ = "Can't allocate zero pages"π        CASE &H8A: S$ = "Logical page out of range"π        CASE &H8B: S$ = "Physical page out of range"π        CASE &H8C: S$ = "Page map hardware RAM full"π        CASE &H8D: S$ = "Page map already has a handle"π        CASE &H8E: S$ = "Page map not mapped to handle"π        CASE &H8F: S$ = "Undefined subfunction number"π        CASE ELSEπ            S$ = "Unknown status number $" + HEX$(Status%)π    END SELECTπ    PRINT "EMM: " + S$πEND SUBππFUNCTION FmtPointer$ (P AS address)π    F$ = "$" + RIGHT$(HEX$(P.Segment), 4)π    F$ = F$ + ":$" + RIGHT$(HEX$(P.Offset), 4)π    FmtPointer$ = F$πEND FUNCTIONππFUNCTION Hi% (Operand%)π    Hi% = Operand% \ 256πEND FUNCTIONππFUNCTION Lo% (Operand%)π    Lo% = Operand% MOD 256πEND FUNCTIONπLogan Ashby                    DETECTING XMS                  FidoNet QUIK_BAS Echo          05-28-93               ASM, QB, PDS           160  10680    XMSDETEC.BASDECLARE SUB V1 ()πDECLARE SUB U (A$)πDEFINT A-Z: DIM SHARED K, S, B&, Z&: V1'Created by PostIt! 7.1πCLOSE : IF S = 168 AND B& = Z& THEN PRINT " :) Ok!" ELSE PRINT " :( Bad!"ππSUB U (A$) : FOR A = 1 TO LEN(A$): C = ASC(MID$(A$, A)) - 37: IF C < 0 THEN C = 91 + C * 32πIF K < 4 THEN K = C + 243 ELSE PRINT #1, CHR$(C + (K MOD 3) * 86); : K = K \ 3: B& = B& + 1πS = (S + C) AND 255: NEXT: LOCATE , 1: PRINT STRING$(B& * 50 \ Z&, 219); : END SUBππSUB V1 : OPEN "O", 1, "XMS.ZIP", 4 ^ 6: Z& = 7405: PRINT STRING$(50, 177);πU "%up()#9%'O%-%%%If=QJ9*;P'7%%;)%%%,%.%%'r%xStgLolc..m9<9??Ht_?GE"πU "Gs*4qkiheF,qbP:7MbTCSGl-4s'P\\vu*'oufn3f4KgDQT3*Q#Q[&wzOmup;cC_"πU "z/FqZqiXa*K\66'KjIF*Q,<f+jL^X[G/FJl>tjlpcJW$&H^$qT?,Kd:0fdH=B&7"πU "a.,]fRtRiM6nK5]g*O]&xfh[T_)Sutqdm5jZ$5[2_[zMDI(G5iE-EK4z:Ec,D&H"πU ">iR\9I_TBf,'W=3hF*[&=>b)U$UskB1eT_RY=N7r9T&G]_O?uhd96<Ta[u_hziB"πU "iX\iWYq0c<f_?RS7rV3Jd3XgC.*ucsO=3]=A&&om,*=UGIbFcu7&I(L0W;vip&o"πU "Gdo:rAf%x=9all''5O^_,2tg<f%a%Z'4R$^<hU%lo6o*-F(e]Y3K)p1*;HnOFOK"πU "*^K?Dw*RQP+hoo3%uz?%&w&$1N)a8,/)M''99($gN*aMl8]IVV;1Ysg4/b6n^3t"πU "U3<(+2XQ>x(W*6tfm]Zwd8DC-lW=DYhFKmo&6QNCkfR_bU<R;SHlks:_7ZlxPg("πU "Y$e4Sw[fbY>Q:^WHn<avQn>Tc8fsY9nBG:b*+Y2tsx].l2Vk=>wf>HkG1D?v[g>"πU "/7qeg7n8Bw7KMY3eqtD,O(45kSp1x5mk4FjR.+Z?3aycHZ>uxvBrk84#,dCBaLf"πU "K#i8MoiGoNG'hi7hkA5UkyM2NaIFDwSDWT'#7,ugB9[pxRl_Fxj#\pumrOk6FV)"πU "TfL&Ug:D*<hWe3]/%exW*,f.Inpc'ZQ9pUDKY5?Rb#j5I'.B:t^W<uq-bFPfY_["πU "dnGZ\l^2SUZ^90-n0,y+L83.\M:bs[N9Z^Z*9Z$c3#;0O01dpeU5/+TF#OS6=^5"πU "=6Ah;0ii7+$WvWjXiT<i\i8**'h]>8+>)4:6SfE;Hgi8_FUFA[8C2pT,f^Ss)qp"πU "9C%5B<>6c<%up()#9%'O%-%%%%f=$S7:]57%%%4^%%%,%.%%'r%xSwjjkN*VGBT"πU "]akNXyvCDIxdLbJ%%P;##5_AD4+nrI3jZ#=k3/alW)+J%ne1(O%YkNvp4C&a7tg"πU "IBfVGylh1hX/rt-PX2=l;H.xp'.xrAGbB]tuP4PJ]dJxqBh<.i%[,<D:zCtPT;'"πU "Gq.zeZJ1Yl+u;RiqXDuwm%B4S4QZ]vnUs0/UYxu6e]SPv;0M9MJ9%A9ik6<>Yro"πU "fZfR5SE6tGjuDMzvuaBOndOnnd:RubRjbuJjjPn-'11Pg7QR?l\lhMG#MAum[^r"πU "6rP->iNM0e+P1XXPtZD,+9dC9C\5*:%xhKY0MsQqhw%[c&POeaI/zY(dN4p)Yu;"πU "neLnCO-S)X0qGA)wMX&x%lI,&T+nPxN+hc0R+SCh1.#M,p$UbW23=?Z>lAdp<e0"πU "T_&zRueQ&/8T<FmW.W9u4Bnq8I]vY3Vt,5^_6oZZ4DT:#]D+Xb:(YKK-W<_.HJt"πU ":;y&v6%9#=W>hiZ\%PpNA)Mdm>N8_Etd'EdIM9(f0LBi2QLJ&%5W7+0O.I%UbtW"πU "(P)#1?\),cY<g.d]g#M35[nZY09wCj/IgCl8(&e_>lB\t,8)fPqx>R(Fa?'+7Sa"πU ">CD9ue][[q&%WMcZ#PL:OoHh]Hu59,Wva/)LiVPlWi=fXlGEy+IygJ'F>t%b3i."πU ",k8S;[vVQeaAlq;KZ[vIL<kNq965S9'5[4^-16q)4yBtKgF?\p8sug?P\Yjtbz("πU "CELf>fkp_p-VojZ\jb^T$5]n7nD]gTAXbk#f;i/j^egeGFL\q$)\F<-:Um[UzcN"πU "XnD%a)u(3LG-o&6+(^67o7H5#lsJYko?_F]R%c#'OuKBFf8<W#z<9b*IlU0l&R7"πU "_Y2^BZHkPT-*c6;OMFuZCqSCbj)7<D6POl,?h;[d#rhUfMU[kYLtE^ypWZkdJj-"πU ".3c-t[4FMI\TlfMJ2iE=Jte7TNGh*<hKV2k\ZrWtkSarrr5R_drT8qU9VW?+LjP"πU "Of&0QePFKa\Fjjw_.riceFE>Gb3<u*APK*k<0*q$^.0*r7r'EiA+(UzbpV=C250"πU "Jz3&Vh2.>R-\2hrW^''jkpbT;j&I8%#b#BF[$)T'jTjI\E6Xt,vEa9/y1Kpt$(B"πU "#tdGCSCZ)xi'<qFC/\z-ghx5%QBn5ch(_yo+Ma&bZZZq\gj%3iU]uqD5DP[u5;)"πU "tK44oH82ErMIu.Ik7(aGHNp<W-u\o7ot?Tfw+/^ggVI#C0xe)5TIXdxzPe73=aL"πU "\?,u&m(Vq#Z$Cv6,+)gp,^XPl4I.wIn9\?O8oxf#9?#RLK-%ARu?Ik]cIcjRJYZ"πU "7'$F4FcoK\k5B8=G3<I6qk,Mo6[[5#]*hQ_1Id/7d2lkAfMG^C?\&E#*h;v8Mu\"πU "y,n_K3DmjtnZRhNHkKD6s[k&%>GM&bz:ePW^/oJ%^$$3RTkL2orVFNI3^GN:&6<"πU "<p(?nEtH^d9Zt>tzbZ,<=sW8VpRqYHOK4[z]R&+rUXUn;I\aVugkW#aZZpH'gS_"πU "0X3O0+xmow[:l#+O6_Fu78$DdEO^<oh/0Sw?4tYi0\j?jVa/q==h#B48+Tt$E]+"πU "L8=rm^[4=;=$,;1#[E5zuSrfIB/Qzu=UH#7;Pw=e,Vhu;^qTi7J,Ctnn'?9>uqF"πU "fV7=KpU*7HbBRG$=1;_tRE5O+)mt\xDHZC48<eag6#,_O;M2gA6fA:4pr$-F(i2"πU "%3A%<K6<Ko<.6g]*9u(KU5-b-h)k5NjgL1g-=G0*KpN]UU*;D.5F0M[Z_4.3oy3"πU "xRel+AV5[Xb>1<tX=>,1OoIA#OI?0=0&%9GJ\MAu)=kD__DLb4&)6'19/D.5N[R"πU "Ja_1-RVl4e6PdAsZhgjoR;+gntseOl_QP#-^l.O-[pX1;5gapT4-X%U=$W_JCB#"πU "4[)l9CbqPoOyWfW;^mDC&[fqf.G)A=i)\M=;5Sck4KLumEMg%Yh3j3sHriso\x1"πU "mwf9jo&aO'G4F:F;eleDw5H/?/o2oc7sq0fi6Af>?Lq4AR3awH]3%rjHD7+Q$vg"πU "^Z)$S%+U_6l9(%7u]88Vl+2VSUiXa*GUUOZD1^ENwFq_0^_d&(kbNz1G*SjR5=P"πU "o,YFR:U<cS;gPb:54Z3LunHF&M7>O0MW>k6#HDPK)<r^Px89T1X?+KP;o0ikJ=i"πU ")in<J_/u_=b1N#nf+9/wypI.Lo()8,[wo8,3$_0-'.<.jDx..lh;?%ywK_DHTc7"πU "(_n+Ud&v$.:VL'?MqKhx\ew$oN-Qy?1nJb6GE.U;$[%q<C:ec:=x#MF.J9y#)^l"πU "gq00yXk1x'Xb2H*j+KVS394o%CpVrl;SJQ1paJBvXHAG$azspCK]Yp4r3:W&cfg"πU "w;l=oC'_.3)%7T.^(WQtz&AO<Up&NOWQYPOm>,;nbIsYW=BdS9U/IOfA;'k[Z+:"πU "GTY:4IW%SijW2X&ckY>%0'D)<cd)Og_Zss6_2t(to._>7wIu(vz/fp2b<0\-8h&"πU "w$W>w]73UW*$PHfA24,h:;JHk]MG'QY5f(rrJXIRYK]J6/:VrF5/$>-8cwF_Pn#"πU "#f(W^S$*6=[N')K)2vIMpSJRdp]]7D7tOiLTpD(v-(Yg]_d0+SFv],;%GEynMCi"πU "]t(zUA0LrTsAgrU0A,hI3UY1(Resn1_Dr\UDJ'Nz/^4,p7s7t,Q2asNDkubZ'g4"πU "I%OHM[X'?E)6*4)HP&D/]swv1i:i#ebD1#dKM\K6p45u'aUo$UD2&TG)0HsjBl$"πU "A,*Yf:qXn)V6JBOVlSYWUB(WZDkU4EXsk)LmPVPNUHRSpFKQ'X4]gS_p6FO'P.*"πU "'cl'AWN#+vV88\W\fQ3h7Fqd/Pc4Z4T43nFj&,</\X[-7mYK[<s3*1MY$3+oZa:"πU "0trTiD$hn0nG3IqTf<B9;jYCOjAnW;Fp47e/1lYVWF_BF0r>1aoCiF.dR*tmhWY"πU "a]=Q2Eo%fhQ>&C8(,+c$)CuWHt/NlIKHaZ3#<2j.>SQ*v=yE3v,LgxnIZb:p9wV"πU "z,.F%2A&AMVdS'LPLOTt:EV,iPrbwLPkFQe+Oe*]6bd>$r:)88zp;>Td84=;qZu"πU "q-<:GvGY7s(B?Rwi)pg>,[nyZp)Z2KCK-B6m9F(M;%KoOT/w56<pQt)TECl9*XX"πU "0/knpG.n=cm1zNYV5Ue%/6mEZ/p-oUL>r;d'4y(Nt;%o<%oS>0b:Q/)z6=7?\>5"πU "T4PK/BRTo6lY0TCm;D#Usy%i<kUPWENPq;EQE4b0,KgnE1xC%](s_&T&l\j]o/4"πU "<hRC;W]?4Ba#8Rgcv<2jS/t$,ie\0HG/0kK+)OQ;FwE#y3?]JM($n5Y.[jlg_5n"πU "cP(+L1j2T>bA=_-=j18>vD1Pr>n/%+n#5:Me9G;CeZw5ZxX=$[dDgWLoCvv7,HC"πU "W7$w_$8a;\-sTV2kX\-:&a$W_SIUZUmTj#;#*IW-tHQ'yr=[m-C:##Pe0i[w9[t"πU "r+fBub3YblsHf\$plvU&4:l$ZZX\9p\Q\tF\j08ctZf59QH;/aWGX;.h&HW]JCm"πU "(\%oysm=3(R_S(b.Oy.,CEkxB-6*<+QOM[x1/:5a%7.-LLcxf;eVgXXu/i<;./("πU "9$7?o^#+p7:XV:>)hZ9k*h[a6hae?GEub-Sob4=B8Mi)219$\;Q?,s9&jRJ9sAm"πU "'Y;qCkw7J5$98SX#g4VRq9wb$h#rs()vatBSV4b)q(4r7=5R*C3Qw$&S*W2hPiL"πU "8hr\\g0gknsNxcd4G52+$SQDoS[#%;;;EYiY?jgQG366Y3dsvju%I+B1kS?1DTK"πU "$Hjh2vZ,Goo8^n,RqnjW59&i9EwBE>5>Hi<f1dQ5O-KB_;W;Ea7Cx'PySP),j?$"πU "%[pk7&Et'[HoJqM&7cflp3HSF_4%ov$0<9B9JkA?*;LUB-8^ttg47%uim?_uA:%"πU "\D_DPf^3hV.$tzgGZr/E1qim0S'M<yxkp,qf$iTqGs>TVo)f[r=Z=MG1$*iCAMR"πU "O8<xa:S:K'gr,l-j0BFVsN/_J'2>D(ROtSVYDKP*'8U?qGrYUa#Mf<*O_3(=)CY"πU "MacZF%nb^^?]/Q9D<^]lvt[vZV1LNN7.>u0x+QQW?0qUZrF/Xv(9VkDQ<PR__o:"πU "w1Q8SE7mHAB^laBI=*IMU(#J27<he6?[q/;2<6KCON_rdd*x,QY6Y\Co&]It,^t"πU "qd^CMr'3PDQ4J3z$CYvT[YFlb4THGvS?A*d\CL'X2;K1tBsH^?9Ff\8Z4Ulj36A"ππU "2]$7>,O?F6b_l$60PKuk^;[bMKZ.=zj5ud5:KdJ<-mKDE1vin5f5U^fGva)RE'S"πU "#sP/ov*8uq]]rx9VTteiw*llQfqMK[j<i7<]m67Yat?=To84AR[OQO0awI9,%j9"πU "c02GiJ^DY+3G%BlU#DFM4V'.Oa2LMRsR\Gimr<lBmr\*b#OJVE7HVch3n1%ZJbd"πU "Mtbqfj3s;Aj*d#>*N*PnSjh6K/Pe]lPz3Jhy^+TMV-GTn*^]mEJE/Bf<2=]?J.N"πU "dY&V-[Y2W=/5=CC.t>Im#j9'.kba$2_Chz,h3UtMkB5p;SbSBGB39_ccW_QG%7#"πU "q?Ifuhx5h=5>p4VQV8#nf+ALoaNV=6uvDjDB^YxH[h\;a/R&u7(1sf>+=N[lj,-"πU "$c/tQICA*f/bQ*hq#2kJDa]66+4ojT4/IEA_p6]&ct[TI\5Y0h;JB31;_Cj9v)p"πU "N'Ej1S$]A#YNpQvX8#AHy9JAa;1rp;u1p1_$+C5Z55^65bldTa>/7^o3eZsPtpF"πU "s.qWnA\OqsJC)GtSfY='F=IR\ZK'$Sot3>)>4$jcx:D-t],3mkx13i6HZxcX8#<"πU "uNq_fBv$KErtU7sOU3j[=S'?Uth;q<rq5DdZIF[0WQf58u;7J5(:,K5CWH380od"πU "rx/UQWr;un'5TIq[.j5WvX=9Wp9CjC_lk2hY:H2F9;FT*^9GIpA0HBi?u3budf&"πU "YiYRM<[/0cCUj9HI[xYM.eGA[j[qL/P6.V7-eLUWCt48MGc\F4ZT\UiDf<H6>$8"πU "nbQh4fG>hKfThcw.e^5I<Cuk[oM:cY)mAKKWmJ]9L&+;dupobo<gFvyoe=lJh)&"πU "R9SAlNT3RAjKU5=)T7QENrstr\VEEv*LTnlVk'rlUD9[4s.4HDoQY$rDD[2Bxtr"πU "F8)+90%Qj+\uXhcFA0ZvfYa>XLZ=^b?og-\h=LAsRHA:b(\8Zk&gKKc?rwo_OBX"πU ">)?dPTU2mFuxX/oLuIc.'D>oXLXprt$$F,mTxt2XU)),$gvnY1AA8?d(#gJ3TsP"πU "'OE8(A-q9)dp/KMKQh;?GIiGt4&\>D,V\me&w95e;xfj97v\9e=->a<e'Yz9tf5"πU "x;_Yp1s4^\&h_]pi0VxiVf:f*Fb21GcYl9U[OQ\EV/<XP/W9*W44N$qN4rQ9(U#"πU "cfcY-O]V;u],p_;jq&PB0Hl-c7f9NBvQwM<a1422Tmx(JH1lt?s[>#UK[u$McLb"πU "dOXlO_U4(7TJp.qS(vXe/yjM,I#HhF<GookhQ.GgAZvS-]-n+RV+f_:k;62)50$"πU "14Y^b>rCvC$q>oT7==YbWz<e14;uUv)xqw;(#2u2T2uG[NSuhhFttMA<ZZkonGp"πU "/F\tk.h=?W(FWhTgC'DPL3B>JqN>2EA;g2Nu2Ve];%AXH]:'ir<-E>sV:=8XraV"πU "\G9(_dKKp\60[8?0=I<\wFCjWjF875i,j%k\*Ye>tOnhj-Yir_jbGSE\N1u-ip="πU "DJN3PU=8XwdC=\xQ=5JBiLMBMzOXgo(GuMJZGMnVG>l8sS%=WE000&s*d&MKG\F"πU "6ei>or)?HS5VH^&#k?kvo#6NALsIMEj/ie+gyh3]/D,\ss3LK$tG[Y8b0Z>9H4d"πU "vOsx+&CfHO,Jdb^J:R4V6fhK8(JiR0Iw$+HCNrGBtmg]oP;HiNJxoJ\L,rl2u4P"πU "w)luottVj?VBr.+u:<taaB%0h8nn[5purMRzCPts,HjH<87A>L,,Yfkt$6FclMN"πU "2]fJfe3PlHqPqL*F672=T$6fR(K*B7=)&tJ&;y:lMKb_3KGjwyxs9D-]LLO.Spz"πU "M6T(_-+i^TG)#uc9XTJvLlv\jtsLa8sL\e:d0deqYz-1KOIjLh&p)aB71k<X11<"πU "TYO5Wt3ZPdDZ\peb8^pMR[cv^>wGf*1fMK\=rB/VEued6-uZ,=ll>OF?Qi<4tNv"πU "Dx%%up(%)9%'&O-%%#%f=O:fACS%+%%<%5%%0#%%%'%rxij%rtSgRfx&&<v>SmF"πU "8wBXNx0QA=2-Mo)qksr$Kk][Dsw)Atgm\N6tD1T?n/oSE0-hKtNvF%ddFs3_^qM"πU ";ZdRRhN$H5E:]IrH=dfO6tK3l'lV4xllT9RP3YXG:h#'8nFj,=[;QO#o[KkX<0B"πU ";SYe+ThH_0xYu8m/x#\=B2BuPo$Ep^M^9jBD/:Cfv7c#)KXW\hD/B4&0.tLb'Bl"πU "#-JBCM/LCV.b=yzku>fI69Bj\tv)A9N\Ns+a?:GiQMK;gT_3EG<=(;(./oP.4Vi"πU "C6%.D':1X0,'%1w8O\L3X.m57'Lo^W<ngD[24YDfW[^KB=5<w.wY.A45SBUaqU6"πU "lJCg6I2)PKv8CJ2J-N1eTDMs,m>R\Ka(.U[q+6xnxl#-t*lHpjS=(9:1:05,C<D"πU "2UEdWKp[iU;#p]$=?0UBZ/_F<=k]6EdSMk*E*_pmOW'XakH$=ghmKmJK8AC\PGl"πU ":kg?):1(\RMGLFs^U5_.$z&(wR)L\OIZnR8eAXL[J;a%P2tX#z-#eB9k02l1%Lg"πU ";k)c*3Gkn&bp)C%:);Ma:5Go<$YAR-eaVf?UNL.*o0xhZs\q?,,d_nw#RHOR'j="πU "kw45?,hb0oNd=iuBR$Ir#)ezUN$7sQIr#-pjVOQb+cTt5tb?\L,<O<I(3d)OQBB"πU "Oqi;+6Rw_u91U*T$[VHsod%X7)BVpP4clcF2SHta^(=R-8uAFkLCv3P5Ar)t)8x"πU "ZABI1KCr$srRE.Nu6VCt/S>0jERpixuB82,nKB(ZM&(dZ&?0Lr94]&#>mafk5Rg"πU "YnL3]IhkdvkXS2[RiKGs$b'&QQD;gv1K#0Fi<M1T.B'.Qv#F8,O5gHJNX#3?wMY"πU "hg;TiY9F+)QI7aXam%oNp7c]9[HsgFr&.\W<,2ihhuh>I^l1YSs7h4kk<0;Y7T5"πU "ZBBJbhG,_l8;pVPV;17_k,+a)e<+CxtVt+Z8\R<;kLBgK/B&]Go)$bU]n9<g.,e"πU "e.h?%aoU]HmKEw_)=ANUiM_-Y^g9C[t%.Gq\JMKTCSP=fVq6i&W3?;>Hldc9oAT"πU "&KX;dXSNJ17?0Y3(*(w\C)q4hRQN?E:i[MihQZX2:6E,BvCAF&l$;>g+5wddi4y"πU "-b&^fKo3lpU*CkvPV5aGs)gTDW0v?sWN[AqX#GCSgbPWF$E+/C7KJ*PCnOWBq+N"πU "SSmhQqBXgaMyCOcG;n([qsSZPQK=4RM6)T')vg#(KB\T->wX'*Rc/,.e^^FsO$U"πU "(7+UTx0Ft0)SFEK;qSN/FBb1AxKH4Ec\4^#%dpfEs7m47:C%y/VK(t&02%R;%?/"πU "3o4*:gBXiR>Q.YL#)?9e/,HN#Rz9x72:E/Lr&u.aUZ7IKOdbtKTcKoZN[-IszbS"πU "&od2fG:l$tT.Sw9m9n506[v)QrJ58pp6&o%9*>e+M71,URYR=G>C0=[s8s8Kff,"πU "9Sm\rY6d&KKYy;GCf$iIWcrM0D9ia9,%N>6,PJU5x$))l</aq-<DbtI3(bP.3&g"πU "%jDSd/+6K=R9Gn:)MB;$Zi,KVBi;CUOmx0FUYHhMjcEj;SG_6V5VBKYCS;_=p,u"πU ",kTZh\0iq=EQ=bv>3O.1BCb2PT(Sy<nTaj(Lp74)?;H18gv&.gx>KWy/,OGWG+$"πU "rGzoWHuXI8O=BZnZi)T0n?Uja7NwReG#.fkR$]V'ZA-BrS2Pe^(QvgjR_v&B]K-"πU "GqM467kqEW,eq'B4f5(GU%9UybeOQxw.PYI2=]7T*R%?ZLTQ3(%gj#-$bqmtKOr"πU "GpBo*BSfS^2&]/30Y/0jA7gWvXgifcO)$k\_kgnca+W/m#pVUa%F.4<8c3(_JS5"πU "t$IFZCl8u[6w]P/c1cLrJ3i6d;XlhP^$Z';HTqZR75PXtdZ47)J(M<YWg&s<uE7"πU "5g;(PkxVQhJ4554Ybp=S=h<*,F\Jfz&[5iH[Oh\ptqTF-;Ok'KNsTJvFTS*gQPb"πU "I($UIqd1<;^dC]D*DybjqIdFf%.,$Oc8X4t%U>=I)gcAo#NIrEq=YE^F>t/Y?HZ"πU "rWnWh56gu0[>80w'%up&'%9%9%%'%-%%%%f=;QJ*;'P'%%';)%%%,%%%%%%%%%%"πU "%E%%%%%%.%%'r%xStg%oup&%'9%9%%'%-%%%%f%=$S:+]57%%%4^%%%,%%%%%%%"πU "%%&%E[%%%u#'%%'%rxSw%jkup%&'9%%9%'%%-%%%.f=Of,ACS+%%%<5%%%0%%%%"πU "%%%%%&%%E%%%'V:%%&'rxi%jrtS%gfxu%p*+%%%%%(#%(%r%%%%Y%A%%%%%"πEND SUBππDon Watkins                    PEEKS AND POKES                PEEKS,AND,POKES                Unknown Date           QB, QBasic, PDS        210  7958     PEEKPOKE.TXT        COMMONLY USED BASIC PEEKS, POKES AND SUBROUTINES π πDUE TO THE LACK OF A COMPREHENSIVE, PUBLISHED DIRECTORY OF COMMONLY USEDπPOKES, PEEKS AND SUBROUTINES THIS LIST HAS BEEN COMPILED BY THE SMUGπPROSIG AS WELL AS A MANY OTHER HARDWORKING PD SOURCES. THANKS AND A TIPπOF THE HAT TO ALL CONTRIBUTORS! ADDITIONS TO THE LIST ARE ENCOURAGED ANDπSHOULD BE ADDRESS TO:π π         DON WATKINS, CIS IBMSIG 76003,252 π π    THERE ARE, OF COURSE NO WARRENTIES OR GUARENTEES THAT ANY OF STUFFπWORKS AND FURTHERMORE, IF IT BLOWS UP YOUR MACHINE IT AIN'T MY FAULT.π   π-----------------------------------------------------------------------π π π    BY SPECIFYING A DEF SEG=&H40 IN ANY BASIC PROGRAM, IT IS POSSIBLE TOπREFERENCE THE FOLLOWING VECTORS (FIELDS) IN THE ROM BIOS AREA BY USING AπPEEK FUNCTION AND THE FOLLOWING OFFSETS FROM THE CURRENT SEGMENT ASππ    DEFINED BY THE DEF SEG STATEMENT. ππ π     &H0       -  RS232 ADDRESSES ON YOUR IBM PC. π          THIS WILL ALLOW YOU TO TELL HOW MANY (UP TO π          FOUR) ASYNC CARDS ARE ATTACHED, IF ANY. ππ     &H8       -  PRINTER ADDRESSES ON YOUR IBM PC.π          THIS WILL TELL YOU WHAT PRINTER ADDRESSES, π          AND HOW MANY (UP TO FOUR) EXIST. EACH IS π          ADDRESSED BY A TWO BYTE HEX VALUE. ππ     &H10      -  EQUIPMENT FLAG.π          THIS FIELD DESCRIBES THE SETTING OF THE π          OPTIONS SWITCHES. IT DESCRIBES WHAT OPTIONAL π          DEVICES ARE ATTACHED TO THE SYSTEM. THE π          FOLLOWING LISTS THE BIT-SIGNIFICANCE OF THIS π          FIELD: π          BIT 0 - INDICATES THAT THERE ARE DISKETTE π                  DRIVES ON THE SYSTEM. π          BIT 1 - NOT USED. π          BIT 2,3 - PLANAR RAM SIZE (00=16K 10=32K 01=48K π                    11=64K) π          BIT 4,5 - INITIAL VIDEO MODE (00=UNUSED π                                        10=40X25 COLOR π                                        01=80X25 COLOR π                                        11=80X25 MONO)π          BIT 6,7 - NUMBER OF DISKETTE DRIVES (00=1 10=2 π                    01=3 11=4) ONLY IF BIT 0 = 1. π          BIT 8   - UNUSED π          BIT 9,10,11 - NUMBER OF RS232 CARDS ATTACHED π          BIT 12  - GAME I/O ATTACHED π          BIT 13  - NOT USED π          BIT 14,15   - NUMBER OF PRINTERS ATTACHED π     &H13      -  MEMORY SIZE IN K BYTES. π     &H15      -  I/O RAM SIZE IN K BYTES. π     &H17      -  KEYBOARD FLAG -- THE FOLLOWING LISTS THE MASKS π          SET TO DESCRIBE CURRENT KEYBOARD STATUS: π          BYTE 1; π          &H80 - INSERT STATE ACTIVE π          &H40 - CAPS LOCK STATE HAS BEEN TOGGLED π          &H20 - NUM LOCK STATE HAS BEEN TOGGLED π          &H10 - SCROLL LOCK STATE HAS BEEN TOGGLED π          &H08 - ALTERNATE SHIFT KEY DEPRESSED π          &H04 - CONTROL SHIFT KEY DEPRESSED π          &H02 - LEFT SHIFT KEY DEPRESSED π          &H01 - RIGHT SHIFT KEY DEPRESSED π          BYTE 2; π          &H80 - INSERT KEY IS DEPRESSED π          &H40 - CAPS LOCK KEY IS DEPRESSEDπ          &H20 - NUM LOCK KEY IS DEPRESSED π          &H10 - SCROLL LOCK KEY IS DEPRESSED π          &H08 - SUSPEND KEY HAS BEEN TOGGLED π     &H49      -  CURRENT CRT MODE π          &H00 - 40X25 BW π          &H01 - 40X25 COLOR π          &H02 - 80X25 BW π          &H03 - 80X25 COLOR π          &H04 - 320X200 COLOR π          &H05 - 320X200 BW π          &H06 - 640X200 BW π          &H07 - 80X25 B&W CARD -- SPECIALIZED USE, USED π                 INTERNAL TO THE VIDEO ROUTINES. π     &H4A      -  NUMBER OF CRT COLUMNS π     &H50      -  CURSOR POSITION (ONE OF EIGHT) π     &H60      -  CURRENT CURSOR MODE π     &H6C      -  LOW WORD OF TIMER COUNT π     &H6E      -  HIGH WORD OF TIMER COUNT π     &H71      -  &H07 - BREAK KEY DEPRESSEDπ     &HFA6E    -  BEGINNING OF CHARACTER REGEN MEMORY π     &HFF53    -  PRTSC ROUTINE ADDRESS π π π    TOGGLE NUM LOCK π     DEG SEG = &H40 : POKE &H17, PEEK(&H17) OR 32   'TO TURN ON π     DEG SEG = &H40 : POKE &H17, PEEK(&H17) AND 223 'TO TURN OFF π π    TOGGLE CAPS LOCK π     DEG SEG = &H40 : POKE &H17, PEEK(&H17) OR 64   'TO TURN ON π     DEG SEG = &H40 : POKE &H17, PEEK(&H17) AND 171 'TO TURN OFF π π    SET SCROLL WINDOW π     10 DEF SEG : POKE 91,20 : POKE 92,25            'SETS UP WINDOW ON LINEπ     20 LOCATE X,20                                  'FORCE CURSOR TO WINDOWπ π    SET WINDOW WIDTH π     DEF SEG : POKE 41,30                           'SETS WINDOW WIDTH tO 30π π    RESTORE FUNCTION KEYS TO DEFAULT π     10 DEF SEG = &HFACE π     20 K = 1 π     30 I = 13 π     40 T$ = STRING$(13,32): J = 1 π     50 T1 = PEEK(I):IF T1 < 0 THEN MID$(T$,J,1) = CHR$(T1):J = J + 1: I = I + 1 : GOTO 50π     60 KEY K,LEFT$(T$,J-1):IF K <10 THEN K = K + 1: I = I + 1: GOTO 40: ELSE KEY ONπ π     DETERMINE MONITOR TYPE π      10 DEF SEG = 0 π      20 MONITOR.TYPE = PEEK(&H410) AND &H40 π      30 IF MONITOR.TYPE = 1 PRINT "40 X 25 COLOR" π      40 IF MONITOR.TYPE = 32 PRINT "80 X 25 COLOR" π      50 IF MONITOR.TYPE = 48 PRINT "MONOCHROME" π π     DETERMINE AMOUNT OF MEMORY INSTALLED (ONLY WORKS FOR GREATER THAN 48K)π      DEF SEG = 0: MEMORY% = PEEK(&H413)+(256*PEEK(&H414)) ππ     OR, PUT ANOTHER WAY: π π         MEMORY INFO:         DEF SEG=0 π π   ((PEEK(1040) AND 12) + 4 ) * 4     - MEMORY ON MOTHER-BOARD π   PEEK(1045) + 256 * PEEK(1046)      - EXPANSION MEMORY (ADD ON) π   PEEK(1043) + 256 * PEEK(1044)      - TOTAL MEMORY π π     READ DRIVE SWITCHES π      DEF SEG = 0: NUMBER.OF.DRIVES% = PEEK(&H410) AND &HC0 π π π      CURRENT DISK INFO:  DEF SEG=64 π      DEF SEG=64 π      PEEK(69)  -  TRACK π      PEEK(70)  -  HEAD π      PEEK(71)  -  SECTOR π  256^PEEK(72)  -  BYTES PER SECTOR π π     DETERMINE IF GAME ADAPTER EXISTS π      10 DEF SEG = 0: GAME.ADAPTER% = PEEK(&H411) AND &H10 π      20 IF GAME.ADAPTER% = 0 THEN GAME.ADAPTER$ = "NO" ELSE GAME.ADAPTER$  = "YES --INSTALLED"π π     KEYBOARD STUFF ππ  TO DISABLE ENTIRE KEYBOARD:  DEF SEG=64: OUT 97,204π  TO RE-ENABLE KEYBOARD:       DEF SEG=64: OUT 97,76 π π  PRINTER STATUS--- AT LEAST ON EPSON --- ππ     DEF SEG=64π     A=PEEK(8)+256*PEEK(9) π     B=(INP(A+1) AND 248) XOR 72 π     IF (B AND 128)<>128 THEN PRINTER OFF LINE ELSE ON LINE π π  INITIALIZE PRINTER:          DEF SEG: OUT A+2,8 π                               OUT A+2,12 π  NOTE: THE A TO INITIALIZE IS FROM PRINTER STATUS ROUTINE π π  A SHORT PROGRAM TO DISABLE AND RE-ENABLE CTRL BREAK FOLLOWS. π π  100 DIM OLD%(4) π  110 DEF SEG=0 π  120 ' SAVE THE OLD CONTROL BREAK ADDRESS π  130 FOR I=&H6C TO &H6F π  140   OLD%(I-&H6C)=PEEK(I)π  150 NEXT π  160 ' ESTABLISH NEW CONTROL BREAK ADDRESS  (POINT TO IRET) π  170 POKE &H6C,&H53 π  180 POKE &H6D,&HFF π  190 POKE &H6E,&H0 π  200 POKE &H6F,&HF0 π  210 DEF SEG π  220 ' RESET OLD CONTROL BREAK ADDRESS π  230 DEF SEG=0 π  240 FOR I=&H6C TO &H6F π  250   POKE I,OLD%(I-&H6C) π  260 NEXT π π π          SAVE AND RESTORE A SCREEN IMAGE π π     1 DEF SEG = &HB800                      'SAVE SCREEN IMAGE...CHANGE FORπ     2 INPUT FILENAME$                       'MONOCHROME.π     3 BSAVE FILENAME$,0,&H4000 π     1000 INPUT "FILENAME";FILENAME$         'RESTORE IMAGE π     1010 CLS π     1020 DEF SEG = &HB800                   'CHANGE TO &HB000 TO MONO π     1030 BLOAD FILENAME$ π π                 NICE TO KNOW π                BASIC UNPROTECT π    ENTER BASICA π    TYPE BSAVE "UN.P",1124,1 π    LOAD "MYPROG π    BLOAD "UN.P",1124 π    THE PROGRAM CAN NOW BE LISTED, EDITED AND SAVED AS A NORMAL FILE. π π    THE LIST IS GROWING BUT COULD BE LONGER!  ANY AND ALL ADDITIONS OFππ    COMMONLY USED SUBROUTINES AND PEEK/POKE LOCATIONS WILL BE GLADLYπADDED. ADDRESS ALL ADDITIONS TO:  DON WATKINS CIS 76003,252 (IBMSIG).πWITH A BIT OF YOUR ASSISTANCE THIS DOCUMENT CAN BECOME AN EFFECTIVE TOOLπFOR THE BASIC PROGRAMMER....  SO CHIP IN.πQuinn Tyler Jackson            NODELIST READER AND COMPILER   FidoNet QUIK_BAS Echo          02-13-93 (00:00)       PDS, VB                140  3600     NODELIST.BAS'NAME:          NODELIST.BASπ'DESC:          Nodelist reader and compilerπ'DIALECT:       PDS 7.1 or VBDOS 1.0π'AUTHOR:        Quinn Tyler Jackson  13 Feb 1993π'       (With great thanks to Coridon Henshaw's original NODELIST.BAS)π'               (My version is 10 times faster than his was.)π'$DYNAMICπ πDEFINT A-ZπTYPE NodelistTypeπ          Zone            AS INTEGERπ          Region          AS INTEGERπ          Net             AS INTEGERπ          Node            AS INTEGERπ          System          AS STRING * 36π          Location        AS STRING * 36π          Sysop           AS STRING * 36π          Phone           AS STRING * 20π          BPS             AS STRING * 5π          Flags           AS STRING * 50πEND TYPEπ πCONST ENTRY_BUFFER = 256πCONST DATA_FIELDS = 8π πDIM SHARED BufferPtr AS INTEGERπ πCLSπParseNodelist "NODELIST.022", "NODELIST.DBF"π πREM $STATICπFUNCTION BreakString% (OutArray() AS STRING * 50, InString AS STRING)π πON LOCAL ERROR GOTO HandleErrorπ πPtr = 1πDOπ      Comma = INSTR(Ptr, InString, ",")π      OutArray(OutArrayPtr) = MID$(InString, Ptr, (Comma - Ptr))π      Ptr = Comma + 1π      OutArrayPtr = OutArrayPtr + 1π      IF OutArrayPtr = 7 THENπ          OutArray(7) = MID$(InString, Ptr)π          EXIT DOπ      END IFπLOOP UNTIL Comma = 0π πBreakString = OutArrayPtrπEXIT FUNCTIONπ πHandleError:π'BreakString = 0πRESUME ExitFunctionπ πExitFunction:π πEND FUNCTIONπ πSTATIC SUB FlushBuffers (FlushFileHandle, NodeList() AS NodelistType)π πFOR Ptr = 0 TO BufferPtrπ π     RecNum = RecNum + 1π     PUT #FlushFileHandle, RecNum, NodeList(Ptr)π πNEXT Ptrπ πREDIM NodeList(0 TO ENTRY_BUFFER) AS NodelistTypeπBufferPtr = 0π πEND SUBπ πSUB ParseNodelist (NodelistFile AS STRING, ParsedListFile AS STRING)π πStartTime! = TIMERπIF DIR$(ParsedListFile) <> "" THENπ     KILL ParsedListFileπEND IFπ π'$STATICπDIM NodelistBuffer(0 TO 7) AS STRING * 50πDIM NodeList(0 TO ENTRY_BUFFER) AS NodelistTypeπ'$DYNAMICπ πBufferPtr = 0π πNodelistHandle = FREEFILEπOPEN NodelistFile FOR INPUT AS NodelistHandle LEN = 1024πParsedListHandle = FREEFILEπOPEN ParsedListFile FOR RANDOM AS ParsedListHandle LEN = LEN(NodeList(0))π πDOπ          LINE INPUT #NodelistHandle, Buffer$π π                     Options = BreakString(NodelistBuffer(), Buffer$)π π                     SELECT CASE LEFT$(Buffer$, 1)π                                CASE "Z"π                                          TempZone = VAL(NodelistBuffer(1))π                                CASE "R"π                                          TempRegion = VAL(NodelistBuffer(1))π                                CASE "H"π                                          SELECT CASE LEFT$(Buffer$, 3)π                                                CASE "Hos"π                                                     TempNet = VAL(NodelistBuffer(1))π                                                CASE "Hub"π                                                     TempNode = VAL(NodelistBuffer(1))π                                          END SELECTπ                                CASE ","π                                          TempNode = VAL(NodelistBuffer(1))π                                CASE ELSEπ                                     GOTO JumpPastπ                     END SELECTπ π                     NodeList(BufferPtr).Zone = TempZoneπ                     NodeList(BufferPtr).Region = TempRegionπ                     NodeList(BufferPtr).Net = TempNetπ                     NodeList(BufferPtr).Node = TempNodeπ                     NodeList(BufferPtr).System = NodelistBuffer(2)π                     NodeList(BufferPtr).Location = NodelistBuffer(3)π                     NodeList(BufferPtr).Sysop = NodelistBuffer(4)π                     NodeList(BufferPtr).Phone = NodelistBuffer(5)π                     NodeList(BufferPtr).BPS = NodelistBuffer(6)π                     NodeList(BufferPtr).Flags = NodelistBuffer(7)π π                     REDIM NodelistBuffer(0 TO 7) AS STRING * 50π πBufferPtr = BufferPtr + 1π πIF BufferPtr = ENTRY_BUFFER THENπ     FlushBuffers ParsedListHandle, NodeList()πEND IFπ πJumpPast:πLOOP UNTIL EOF(NodelistHandle)π πFlushBuffers ParsedListHandle, NodeList()πPRINT INT(TIMER - StartTime! + .5); "seconds."π πEND SUBπJane Griscti                   PRINT SOURCE CODE LISTING      Night Owl v10 CD-ROM           Year of 1993           QB, QBasic, PDS        1167 39175    QBLISTER.BAS'****************************************************************************π'* QBLISTER.BAS  Program prints QBasic or QuickBasic source code listings.π'*               The output is formatted at 12cpi with a left margin, pageπ'*               breaks, title, and numbers.π'*               Lines which exceed 96 chrs are broken at logical points.π'*               The user can select:π'*                  a file from any drive or directory.π'*                  to print a complete, continuous listingπ'*                  to print a full listing with subs and functionsπ'*                    printed on seperate pages, orπ'*                  to print only one sub or functionπ'*π'*               Limitations: File read must be in ASCIIπ'*                            No way to intercept DOS drive access errorsπ'*                            No way to access print spoolerπ'*                    π'*               Usage Notes: Printer codes are for IBM/Epson compatiblesπ'*                            See PrintFile Sub-routineπ'* Jane Griscti (c) 1993π'*  [e-mail]  or [e-mail]π'****************************************************************************πDEFINT A-Zππ'******************************************π'*            Type Definitions            *π'******************************************πTYPE Lstπ    Choice  AS INTEGER              'index of currently selected itemπ    LCol    AS INTEGER              'Starting columnπ    MaxLen  AS INTEGER              'width of listπ    Rows    AS INTEGER              'number of rows to be displayedπ    TopRow  AS INTEGER              'starting display lineπ    CurRow  AS INTEGER              'screen row of current selectionπ    TopEl   AS INTEGER              'first array element to be displayedπEND TYPEππ'******************************************π'*  SubRoutine and Function Declarations  *π'******************************************πDECLARE SUB Backdrop (TitleColor)πDECLARE SUB BoxSL (TRRow, TRCol, BRRow, BRCol, Shadow, Title$)πDECLARE SUB CleanUp (OldDrv$, OldDir$)πDECLARE SUB DrawScreen1 ()πDECLARE SUB DrawScreen2 ()πDECLARE SUB GetCurrPath ()πDECLARE SUB GetDirNames (CurrDir$)πDECLARE SUB GetFiles (CurrDir$)πDECLARE SUB InitDrvs ()πDECLARE SUB InitDirs ()πDECLARE SUB InitFiles ()πDECLARE SUB InitSubsFuncs ()πDECLARE SUB PrintFile (FileName$, SepPages, SearchName$)πDECLARE SUB PrintHeader (Margin, Header$, Lines, PageNo)πDECLARE SUB ScrollLst (Array$(), Table AS Lst, Action%, Wnd%)πDECLARE SUB SelectDrv (Wnd)πDECLARE SUB SelectDir (Wnd)πDECLARE SUB SelectFile (FileName$)πDECLARE FUNCTION Answer% (Prompt$)πDECLARE FUNCTION LastEl% (a$())πππ'******************************************π'*     Define Variables and Arrays        *π'******************************************πCOMMON SHARED FGColor AS INTEGER, BGColor AS INTEGER, OldColor AS INTEGERπCOMMON SHARED CurrDir AS STRING, CurrDrv AS STRINGπREDIM SHARED DirNames$(50), FileNames$(100), Funcs$(50), Subs$(50)πDIM SHARED DrvLst AS Lst, FileLst AS Lst, DirLst AS Lst, DrvNames$(5)πDIM SHARED SubLst AS Lst, FuncLst AS Lstππ' --------- Fill DrvNames$ arrayπDrvNames$(1) = " [ A ]"πDrvNames$(2) = " [ B ]"πDrvNames$(3) = " [ C ]"πDrvNames$(4) = " [ D ]"πDrvNames$(5) = " [ E ]"ππ'******************************************π'*      Set up Error Handler              *π'******************************************πON ERROR GOTO CheckError                    'if error goto this labelπππ'******************************************π'*       Initialize and draw the screen   *π'******************************************πWIDTH 80, 25: SCREEN 0                  'set screen page and sizeπOldColor = SCREEN(CSRLIN, POS(0), -1)   'save original screen colorsπENVIRON "DIRCMD="                       'make sure no /P(AUSE) in dir commandπFGColor = 8                             'foreground color - greyπBGColor = 3                             'bacground color - cyanπCOLOR FGColor, BGColor                  'set colorsπCLS                                     'clear screenπCALL GetCurrPath                        'get default drive and directoryπCALL DrawScreen1                        'Draw display screenπOldDrv$ = CurrDrv$                      'save original driveπOldDir$ = CurrDir$                      'save original directoryππ' ---------- Initialize listsπCALL InitDrvsπCALL InitDirsπCALL InitFilesπCALL InitSubsFuncsπ         π' ---------- Display default directory and filesπDrvLst.Choice = ASC(CurrDrv$) - 65 + 1      'select current drive as defaultπCALL ScrollLst(DrvNames$(), DrvLst, 1, 1)πCALL GetDirNames(CurrDir$)πCALL ScrollLst(DirNames$(), DirLst, 1, 2)πCALL GetFiles(CurrDir$)πCALL ScrollLst(FileNames$(), FileLst, 1, 3)πππ'******************************************π'*          Main loop                     *π'******************************************πWnd = 3                                 'set FileNames as active WindowππDO WHILE Wnd <> -1π   SELECT CASE Wndπ      CASE 1π    CALL ScrollLst(DrvNames$(), DrvLst, 0, Wnd)π      CASE 2π    CALL ScrollLst(DirNames$(), DirLst, 0, Wnd)π      CASE 3π    CALL ScrollLst(FileNames$(), FileLst, 0, Wnd)π      CASE 4π    CALL ScrollLst(Funcs$(), FuncLst, 0, Wnd)π      CASE 5π    CALL ScrollLst(Subs$(), SubLst, 0, Wnd)π      CASE 10π    CALL DrawScreen1π    CALL SelectDrv(Wnd)π    CALL ScrollLst(DrvNames$(), DrvLst, 1, 1)π    CALL ScrollLst(DirNames$(), DirLst, 1, 2)π    CALL ScrollLst(FileNames$(), FileLst, 1, 3)π     π      CASE 20π    CALL SelectDir(Wnd)π    CALL ScrollLst(DrvNames$(), DrvLst, 1, 1)π    CALL ScrollLst(DirNames$(), DirLst, 1, 2)π    CALL ScrollLst(FileNames$(), FileLst, 1, 3)ππ      CASE 30π    ' ------ Setup Filenameπ    FileName$ = FileNames$(FileLst.Choice)ππ    ' ------ Make sure selected file is in ASCIIπ    OPEN FileName$ FOR INPUT AS #1π    LINE INPUT #1, LineBuffer$π    CLOSE #1π       π    Char$ = LEFT$(LineBuffer$, 1)π    CharVal = ASC(Char$)ππ    IF CharVal = 252 THEN                   'file is in Binary formatπ      CALL Backdrop(0)π      COLOR 7, 4π      CALL BoxSL(10, 8, 15, 72, 1, "")π      COLOR 7, 4π      LOCATE 12, 10π      PRINT FileName$; " is a binary file...please select an ASCII file"π      LOCATE 13, 27π      PRINT "Press any key to continue..."π      BEEP: BEEPπ      WHILE INKEY$ = "": WENDπ      COLOR FGColor, BGColorπ      CLSπ      Wnd = 10π    END IFπ       π    IF Wnd <> 10 THEN               ' OK, file is ASCIIπ      ' ------ Find out if user wants to print complete fileπ      CALL Backdrop(0)π      CALL BoxSL(9, 15, 13, 70, 1, "")π      LOCATE 11, 18π      IF Answer%("Print entire file?") THENπ        LOCATE 12, 18π        IF Answer%("Print FUNCTIONS and SUBS on seperate pages?") THENπ          SepPages = 1π        ELSEπ          SepPages = 0π        END IFπ        Wnd = 60π      ELSEπ        CALL SelectFile(FileName$)π        CALL DrawScreen2π        CALL ScrollLst(Funcs$(), FuncLst, 1, 4)π        CALL ScrollLst(Subs$(), SubLst, 1, 5)π        Wnd = 5π      END IFπ    END IFππ      CASE 40, 50, 60π    IF Wnd = 40 THENπ      SearchName$ = "FUNCTION " + Funcs$(FuncLst.Choice)π    ELSEIF Wnd = 50 THENπ      SearchName$ = "SUB " + Subs$(SubLst.Choice)π    ELSEπ      SearchName$ = ""π    END IFπ       π    CALL PrintFile(FileName$, SepPages, SearchName$)π       π    Wnd = 10                      'go back to drv,dir,filename displayπ    π     END SELECTπLOOPπ πCALL CleanUp(OldDrv$, OldDir$)                  'reset orig colors,dirππEND                                             'end programππ'----------- Error handling routineππCheckError:π    '----------- Printer not onπ    IF ERR = 25 THENπ       LOCATE 20, 25π       COLOR 7, 4                      ' set colors to red and whiteπ       PRINT "Please turn on your printer"π       COLOR FGColor, BGColorπ       RESUMEπ    END IFπ     ππ    '----------- Input past end of fileπ    IF ERR = 62 THENπ       EmptyFile = 1π       FileNames$(1) = " < No Files Found >"π       RESUME NEXTπ    END IFππ         π    '----------- Unexpected errorπ    COLOR 7, 4                          'set colors to red and whiteπ    BEEP                                'make a noise to alert userπ    LOCATE 23, 20π    PRINT "Unexpected Error: "; ERR;    'print error messageπ    PRINT "Press any key to End."π    CLOSE                               'force close of any open filesπ    WHILE INKEY$ = "": WEND             'pause to read messageπ    CALL CleanUp(OldDrv$, OldDir$)      'reset orig colors, dirπ    END                                 'exit programππFUNCTION Answer% (Prompt$)π'***************************************************************************π'* FUNCTION:            Answerπ'*π'* PARAMETERS:          Prompt$    Question to be askedπ'***************************************************************************ππ' ------ Ask the questionπPRINT Prompt$; " (Y/N)"ππ' ------ Wait for Y or N to be pressedπDOπ  Ky$ = INKEY$π  IF LEN(Ky$) AND INSTR("YyNn", Ky$) > 0 THEN EXIT DOπLOOPππ' ------ Return 0 for N, Non-zero for YesπAnswer% = INSTR("Yy", Ky$)ππEND FUNCTIONππSUB Backdrop (TitleColor)π'****************************************************************************π'* SUB FUNCTION:    Backdropπ'*                  Draws the background screen by repeating a pattern ofπ'*                  characters.  Places a title on the bottom screen row.π'* PARAMETERS:      TitleColor  - color to use for printing screen titleπ'****************************************************************************ππLOCATE 1, 17                    'position cursorπCOLOR TitleColor, BGColor       'print title in black instead of greyπPRINT "QBasic or QuickBasic Source Code Print Utility";πCOLOR FGColor, BGColorπPRINT STRING$(1840, 177);       'fill the screen with CHR$(177)πLOCATE 25, 1                    'locate cursorπPRINT "QBLISTER  v1.00, (c) 1993, Jane Griscti";ππEND SUBππSUB BoxSL (TLRow, TLCol, BRRow, BRCol, Shadow, Title$) STATICπ'****************************************************************************π'* SUB FUNCTION:    BoxSLπ'*                  Draws a solid box with a single line border, anπ'*                  optional shadow and title.  Parameters define top leftπ'*                  and bottom right corners of box to be drawn.π'*π'* PARAMETERS:      TLRow       Top Left Row coordinateπ'*                  TLCol       Top Left Column coordinateπ'*                  BRRow       Bottom Right Row coordinateπ'*                  BRCol       Bottom Right Column coordinateπ'*                  Shadow      0 = do not draw shadowπ'*                              1 = draw shadowπ'*                  Title$      Blank string = no titleπ'*π'****************************************************************************ππ    LOCATE TLRow, TLCol             'position cursorππ    '----- Draw the top of the boxπ    PRINT CHR$(218) + STRING$(BRCol - TLCol - 1, 196) + CHR$(191);ππ    '----- Print the titleπ    IF Title$ <> "" THEN                            'if string is not emptyπ      IF LEN(Title$) < (BRCol - TLCol + 2) THEN     'if string not too longπ        LOCATE TLRow, TLCol + 1                     'position cursorπ        PRINT CHR$(60) + Title$ + CHR$(62)          'print title stringπ      END IFπ    END IFππ    '----- Draw the middle of the boxπ    FOR i = TLRow + 1 TO BRRow - 1π      LOCATE i, TLColπ      PRINT CHR$(179) + STRING$(BRCol - TLCol - 1, 32) + CHR$(179);π    NEXTππ    '----- Draw the bottom of the boxπ    LOCATE BRRow, TLColπ    PRINT CHR$(192) + STRING$(BRCol - TLCol - 1, 196) + CHR$(217);ππ    π    IF Shadow THEN                      'if Shadow flag = 1 thenπ                    ' draw right side of shadowπ    FOR i = TLRow + 1 TO BRRow          'top of loopπ      Clr = SCREEN(i, BRCol + 1, 1)     'Get existing screen colorπ      COLOR 0, Clr \ 16                 'Use hi byte for background colorπ      LOCATE i, BRCol + 1               'Position the cursorπ      PRINT CHR$(177) + CHR$(177);      'Print Shadow characterπ    NEXT                                'bottom of loopπ                    ' draw bottom shadowπ    FOR i = TLCol + 2 TO BRCol + 2      'top of loopπ      Clr = SCREEN(BRRow + 1, i, 1)     'get existing screen colorπ      COLOR 0, Clr \ 16                 'use hi byte for background colorπ      LOCATE BRRow + 1, i               'position cursorπ      PRINT CHR$(177);                  'print shadow characterπ    NEXT                                'bottom of loopππ    END IF                              'end of shadow drawingππEND SUB                                 'exit this routineππSUB CleanUp (OldDrv$, OldDir$)π'***************************************************************************π'* SUB:         CleanUpπ'*                Resets the system to original colors, drive and directoryπ'*π'* PARAMETERS:  OldDrv$     Original Drive letterπ'*              OldDir$     Original Directory Nameπ'***************************************************************************ππCLOSE                                   ' make sure all files are closedπCOLOR OldColor AND 15, OldColor \ 16πCLSπDosCom$ = OldDrv$ + ":"πSHELL DosCom$πDosCom$ = "cd " + OldDir$πSHELL DosCom$ππEND SUBππSUB DrawScreen1π'***************************************************************************π'* SUB FUNCTION:        DrawScreen1π'*                      Draws the initial display screenπ'* PARAMETERS:          Noneπ'***************************************************************************ππCALL Backdrop(0)                        'draw background grey, cyanπCALL BoxSL(3, 5, 6, 75, 1, "")          'draw Instructions BoxπLOCATE 4, 6                             'position cursorπPRINT "   [TAB] - Move between windows" 'print instructionπLOCATE 5, 6                             'position cursorπPRINT "[Arrows] - Highlight selection"  'print instructionπLOCATE 4, 40                             'position cursorπPRINT "[ENTER] - Accept selection"       'print instructionπLOCATE 5, 40                            'position cursorπPRINT "  [ESC] - EXIT"                  'display instructionππCALL BoxSL(9, 5, 15, 20, 1, "Drives")   'draw Drive List BoxππCALL BoxSL(17, 5, 20, 20, 1, "Directory")  'draw Curr Dir boxπLOCATE 17, 6ππCALL BoxSL(9, 25, 22, 45, 1, "Sub-Directories")'draw Directory List BoxπLOCATE 9, 26                            ' position cursorππCALL BoxSL(9, 50, 22, 75, 1, "Files")   'draw File List BoxπLOCATE 9, 51                            'position cursorπππEND SUBππSUB DrawScreen2π'***************************************************************************π'* SUB:         DrawScreen2π'*              Draw screen for display of Sub-Routine and Function Namesπ'*π'***************************************************************************πCALL Backdrop(0)πCALL BoxSL(3, 5, 6, 71, 1, "")πLOCATE 4, 10πPRINT "[TAB] to move between windows               [ESC] to exit"πLOCATE 5, 10πPRINT "[ENTER] to select Function or Sub-routine"πCALL BoxSL(9, 5, 22, 35, 1, "Functions")πCALL BoxSL(9, 40, 22, 71, 1, "Sub-Routines")ππEND SUBππSUB GetCurrPathπ'***************************************************************************π'* SUB:                 GetCurrPathπ'*                         Gets the current path nameπ'* PARAMETERS:          Noneπ'* SHARED VARIABLES:    CurrDir$π'*                      CurrDrv$π'***************************************************************************ππ  SHELL "dir *. > tmppath.dat"        'capture current dir info in fileπ  OPEN "tmppath.dat" FOR INPUT AS #1  'open file for inputπ  FOR i = 1 TO 4                      'loop to fourth lineπ  INPUT #1, x$                       'assign lines to temp variableπ  NEXT iπ  CLOSE 1π  Y = LEN(x$)                         'store the string lengthπ  CurrDir$ = MID$(x$, 14, Y - 12)     'capture directory nameπ  CurrDrv$ = LEFT$(CurrDir$, 1)       'capture drive letterπ  SHELL "del tmppath.dat"             'delete temporary fileππEND SUBππSUB GetDirNames (CurrDir$)π'***************************************************************************π' SUB ROUTINE:      GetDirNamesπ'*                  Displays the sub-directories assocated with currentπ'*                  directory and highlights the currently selected directoryπ'* PARAMETERS:      CurrDir$        Current directoryπ'***************************************************************************ππIF LEN(CurrDir$) > 3 THENπ  '---------- Write subdirectory names to temp fileπ  DosCom$ = "dir " + CurrDir$ + "\*.  /on >tmpdir.dat"    'set up DOS commandπ  SHELL DosCom$                                           'run DOSπELSEπ  DosCom$ = "dir *. /on >tmpdir.dat"π  SHELL DosCom$πEND IFππ  '---------- Write names to an array, assumes no more than 50 dir namesπ  REDIM DirNames$(50)                        're-dimension arrayπ  i = 0                                      'count variableπ  OPEN "TMPDIR.DAT" FOR INPUT AS #1          'open file to read namesππ  DO                                         'start of DO loopπ    INPUT #1, x$                           'assign name to arrayπ    IF INSTR(1, x$, "<DIR>") THEN          'make sure it's a dir nameπ       i = i + 1                           'increment counterπ       DirNames$(i) = LEFT$(x$, 8)         'if it is, save name arrayπ    END IFπ  LOOP WHILE NOT (EOF(1))                    'while not end of fileππ  CLOSE 1                                    'close fileπ  SHELL "del tmpdir.dat"                     'delete temporary fileππ' ------------ Put current dir name on screenπLOCATE 19, 8πPRINT SPACE$(12)                             'clear old nameπIF LEN(CurrDir$) > 3 THENπ  x = LEN(CurrDir$)                          'length of current pathπ  Y = 1                                      'position indicatorπ  WHILE (Y < x) AND (Y <> 0)                 'begin search for "\"π    Y = INSTR(Y, CurrDir$, "\")              'assign positon of "\"π    IF (Y <> 0) THEN                         'match foundπ    mark = Y                               'save position of "\"π    Y = Y + 1                              'start next searchπ    END IFπ  WENDπ  LOCATE 19, 8π  PRINT RIGHT$(CurrDir$, x - mark)πELSE                                         'you're in the root directoryπ  LOCATE 19, 8π  PRINT " [ROOT] "πEND IFππEND SUBππSUB GetFiles (CurrDir$)π'***************************************************************************π'* SUB ROUTINE:     GetFilesπ'*                  Get the names of all files with the ".BAS" extensionπ'*                  in the current directory and store them in an arrayπ'* PARAMETERS:      CurrDir$    Current path nameπ'***************************************************************************πSHARED EmptyFileπEmptyFile = 0ππ'---------- Write files names to temp fileπIF LEN(CurrDir$) > 3 THENπ  DosCom$ = "dir " + CurrDir$ + "\*.bas /b /on >tmpfiles.dat"πELSEπ  DosCom$ = "dir *.bas /b /on >tmpfiles.dat"πEND IFππSHELL DosCom$                              'run DOS commandππ'---------- Write names to an array, assumes no more than 100 file namesπREDIM FileNames$(100)                      're-dimension arrayπi = 1                                      'count variableππOPEN "TMPFILES.DAT" FOR INPUT AS #1        'open file to read namesπIF EmptyFile = 0 THENπ    DO                                         'doπ        INPUT #1, FileNames$(i)                'assign name to arrayπ        i = i + 1                              'increment counterπ    LOOP WHILE NOT (EOF(1))                    'while not end of fileπEND IFππCLOSE 1                                    'close fileππSHELL "del tmpfiles.dat"                   'delete temporary fileππEND SUBππSUB InitDirsπ'**************************************************************************π'* SUB:         InitDirsπ'*                Sets up starting values for Directory Scroll Listπ'*π'* PARAMETERS:  Noneπ'* SHARED:      DirLst()π'**************************************************************************ππDirLst.Choice = 1                   'starting array elementπDirLst.LCol = 26                    'left column start positionπDirLst.MaxLen = 19                  'width of listπDirLst.Rows = 12                    '# of display rows allowedπDirLst.TopEl = 1                    'first array element to be displayedπDirLst.TopRow = 10                  'starting display rowπDirLst.CurRow = 1ππEND SUBππSUB InitDrvsπ'***************************************************************************π'* SUB:         InitDrvsπ'*                Sets up starting values for Drives Scroll Listπ'*π'* PARAMETERS:  Noneπ'* SHARED:      DrvLst()π'***************************************************************************ππDrvLst.Choice = 1                   'starting array elementπDrvLst.LCol = 6                     'left column start positionπDrvLst.MaxLen = 14                  'width of listπDrvLst.Rows = 5                     '# of display rows allowedπDrvLst.TopEl = 1                    'first array element to be displayedπDrvLst.TopRow = 10                  'starting display rowπDrvLst.CurRow = 1ππEND SUBππSUB InitFilesπ'***************************************************************************π'* SUB:         InitFilesπ'*                Sets up starting values for Files Scroll Listπ'*π'* PARAMETERS:  Noneπ'* SHARED:      FileLst()π'**************************************************************************ππFileLst.Choice = 1                  'starting array elementπFileLst.LCol = 51                   'left column start positionπFileLst.MaxLen = 24                 'width of listπFileLst.Rows = 12                   '# of display rows allowedπFileLst.TopEl = 1                   'first array element to be displayedπFileLst.TopRow = 10                 'starting display rowπFileLst.CurRow = 1ππEND SUBππSUB InitSubsFuncsπ'***************************************************************************π'* SUB:         InitSubsFuncsπ'*                Sets up starting values for Sub-routine and Functionπ'*                Scroll Listsπ'*π'* PARAMETERS:  Noneπ'* SHARED:      SubLst()π'*              FuncLst()π'****************************************************************************ππ' ---------- Initialize parameters for Sub-routine ListππSubLst.Choice = 1                   'starting array elementπSubLst.LCol = 41                    'left column start positionπSubLst.MaxLen = 30                  'width of listπSubLst.Rows = 12                    '# of display rows allowedπSubLst.TopEl = 1                    'first array element to be displayedπSubLst.TopRow = 10                  'starting display rowπSubLst.CurRow = 1ππ' ---------- Initialize parameters for Function ListππFuncLst.Choice = 1                   'starting array elementπFuncLst.LCol = 6                     'left column start positionπFuncLst.MaxLen = 29                  'width of listπFuncLst.Rows = 12                    '# of display rows allowedπFuncLst.TopEl = 1                    'first array element to be displayedπFuncLst.TopRow = 10                  'starting display rowπFuncLst.CurRow = 1ππEND SUBππFUNCTION LastEl% (a$()) STATICπ'**************************************************************************π'*  FUNCTION:       LastElπ'*                  Finds the last element in a string arrayπ'*  PARAMETERS:     A$  Array being worked onπ'**************************************************************************πFOR i = UBOUND(a$) TO 1 STEP -1             'start at the last elementπ  IF LEN(RTRIM$(a$(i))) THEN                'if it is not nullπ    LastEl% = i                             'assign function valueπ    EXIT FUNCTIONπ  END IFπNEXT                                        'otherwise keep lookingππEND FUNCTIONππSUB PrintFile (FileName$, SepPages, SearchName$)π'**************************************************************************π'* SUB:         PrintFileπ'*                Routine initializes the printer, opens the selected fileπ'*                reads, formats and prints each line.π'*π'* PARAMETERS:  FileName$       Name of file to be openedπ'*              SepPages        Seperate page for subs/functions indicatorπ'*                              1 = print seperate pagesπ'*                              0 = do not print seperate pagesπ'*              SearchName$     Name of specific Sub or Function to be printedπ'*                              Empty string means none selectedπ'**************************************************************************ππ   ' ------ Set up Page and Line counter variablesπ   PageNo = 0π   Lines = 0π         π   ' ---------- Make sure printer is onlineπ    CALL Backdrop(0)π    COLOR 7, 4                              'set color to red and whiteπ    CALL BoxSL(9, 15, 15, 70, 1, "")π    COLOR 7, 4π    LOCATE 11, 17π    PRINT "Please ensure your printer is ON and READY for input"π    LOCATE 12, 17π    IF SearchName$ <> "" THENπ      INPUT "Starting page number"; PageNoπ      IF PageNo > 0 THEN PageNo = PageNo - 1π    END IFπ    LOCATE 13, 17π    PRINT "Press any key to continue ..."π    BEEP: BEEPπ    WHILE INKEY$ = "": WENDπ    COLOR FGColor, BGColor                  ' reset colorsπ                           ππ   ' ------------ Open file and initialize printer settingsπ    OPEN FileName$ FOR INPUT AS #1    ' open the file for inputππ    ' *************************************************************π    ' * CHANGE THESE CODES IF PRINTER IS NOT IBM/EPSON COMPATIBLE *π    ' * OR TO CHANGE CHARACTER SIZE.                              *π    ' * Note:  If you change CPI, reconfigure the page header as  *π    ' *        it's predefined for 96 CPI.                        *π    ' *************************************************************π    CPIChr = 58                       ' 58 = 12 cpiπ    PrnLen = 96 - 1                   ' at 12cpi line length=96 charsπ    FFChar = 12                       ' Form Feed Characterπ    TenCPI = 18                       ' 18 = 10 cpiπ    ESCChr = 27                       ' ESC codeπ    LPRINT CHR$(ESCChr); CHR$(CPIChr) ' initialize printerπ    '***************************************************************ππ    WIDTH LPRINT PrnLen + 1           ' set printer width for cpiπ    Margin = 5                        ' left margin widthπ    Margin$ = STRING$(Margin, " ")    ' build margin stringππ   ' ------ Build page title and print first page headerπ    IF LEN(FileName$) < 12 THENπ      FileName$ = FileName$ + STRING$(12 - LEN(FileName$), " ")π    END IFπ    Header$ = " FILENAME: " + FileName$ + SPACE$(7) + "DATE: " + DATE$π    Header$ = Header$ + SPACE$(8) + "TIME: " + TIME$ + SPACE$(10) + "Page: "π   π    CALL PrintHeader(Margin, Header$, Lines, PageNo)π       π       π   ' ------ Get first line to be printed, if entire file was selectedπ   '        then first line of file = first print line, otherwise, findπ   '        the first line of the selected SUB or FUNCTIONπ       π    TestStr = LEN(SearchName$)π    LINE INPUT #1, LineBuffer$π    IF TestStr > 1 THENπ      IF LEFT$(SearchName$, 8) <> "SUB MAIN" THENπ        DOπ          IF LEFT$(LineBuffer$, TestStr) = SearchName$ THENπ        EXIT DOπ          END IFπ          LINE INPUT #1, LineBuffer$π        LOOP UNTIL EOF(1)π      END IFπ    END IFπππ      ' ------ Read each line in the file and print itππ      DO UNTIL EOF(1)π       π    Temp$ = Margin$ + LineBuffer$ππ      rspc = 0                              'right space markerπ      Temp1$ = ""                           'temp string holderπ      Margin1$ = ""                         'multiple line marginπ    π      DO WHILE LEN(Temp$) > PrnLenπ        ' ------ Get the first portion of the stringπ        Temp1$ = RTRIM$(LEFT$(Temp$, PrnLen))ππ        ' ------ Find the right most spaceπ        i = 1π        DO WHILE i > 0π          i = INSTR(rspc + 1, Temp1$, " ")π          IF i > 0 THEN rspc = iπ        LOOPπ        π        ' ------ Print the string portionπ        IF Lines > 60 THENπ          LPRINT CHR$(FFChar)π          CALL PrintHeader(Margin, Header$, Lines, PageNo)π        END IFπ        LPRINT LEFT$(Temp1$, rspc - 1)π        Lines = Lines + 1π       π        ' ------ Increase margin for multiple print linesπ        Margin1$ = "  "π       π        ' ------ Assign remainder of original string to Temp$π        Temp$ = Margin$ + Margin1$ + RIGHT$(Temp$, LEN(Temp$) - rspc)ππ      LOOPπ     π      ' ------ Print short line or last portion of long lineπ      IF Lines > 60 THENπ        LPRINT CHR$(FFChar)π        CALL PrintHeader(Margin, Header$, Lines, PageNo)π      END IFπ      LPRINT Temp$π      Lines = Lines + 1π     π     π      LINE INPUT #1, LineBuffer$              'get the next line in fileππ      ' ----------- If selected to print SUBS and FUNCTIONS on seperateπ      '             pages, check to see if a new one is encounteredππ    IF SepPages = 1 THENπ      IF LEFT$(LineBuffer$, 3) = "SUB" OR LEFT$(LineBuffer$, 8) = "FUNCTION" THENπ        LPRINT CHR$(FFChar)                     'issue Form Feed instructionπ        CALL PrintHeader(Margin, Header$, Lines, PageNo)π      END IFπ    END IFππ      π      ' ----------- If printing a MAIN, SUB, or FUNCTION, exit loop when youπ      '             reach the end of the routineππ      IF TestStr > 1 THENπ    IF INSTR(SearchName$, "MAIN MODULE") THENπ      IF LEFT$(LineBuffer$, 3) = "SUB" OR LEFT$(LineBuffer$, 8) = "FUNCTION" THENπ        CLOSEπ        LPRINT CHR$(FFChar)π        LPRINT CHR$(TenCPI)π        EXIT SUBπ      END IFπ    END IFππ    IF INSTR(LineBuffer$, "END SUB") OR INSTR(LineBuffer$, "END FUNCTION") THENπ      EXIT DOπ    END IFπ      END IFππ   LOOPπ     π   CLOSE                                     'close filesπ   LPRINT Margin$ + LineBuffer$              'print last line in fileπ   LPRINT CHR$(FFChar)                       'send final form feedπ   LPRINT CHR$(TenCPI);                      'set printer back to 10cpiπEND SUBππSUB PrintHeader (Margin, Header$, Lines, PageNo)π'***************************************************************************π'* SUB:         PrintHeaderπ'*                Prints the page title centered in a graphics boxπ'*π'* PARAMETERS:  Margin      left margin widthπ'*              Header$     title to be printedπ'*              Lines       line counterπ'*              PageNo      page counterπ'***************************************************************************ππPageNo = PageNo + 1                     ' increase page counterπLines = 5                               ' reset line counterπLPRINT SPC(Margin); CHR$(201) + STRING$(88, 205) + CHR$(187)πLPRINT SPC(Margin); CHR$(186); Header$;πLPRINT USING "##"; PageNo;πLPRINT SPC(2); CHR$(186)πLPRINT SPC(Margin); CHR$(200) + STRING$(88, 205) + CHR$(188);πLPRINT : LPRINTππEND SUBππSUB ScrollLst (Array$(), Table AS Lst, Action, Wnd)π'***************************************************************************π'* SUB ROUTINE:         ScrollLstπ'*                      Routines allows scrolling through a list of arrayπ'*                      namesπ'*π'* PARAMETERS:          Array$()    Array of items to be scrolledπ'*                      Table       Parameters applied to arrayπ'*                      Action      0  bypass initial displayπ'*                                  1  display and poll for keypressπ'*                      Wnd         1  Drives Windowπ'*                                  2  Directory Windowπ'*                                  3  File Windowπ'*                                  4  Functions Windowπ'*                                  5  Sub-Routine Windowπ'*π'**************************************************************************ππ' ------ Set up parameters for listπTopRow = Table.TopRow                   ' start screen row for displayπRows = Table.Rows                       ' no. of rows to displayπBotRow = Rows + TopRow - 1              ' bottom screen row of displayπLastCh = Table.Choice                   ' current array elementπLastCurRow = Table.CurRow               ' last array choice display rowπElements = LastEl%(Array$())            ' # of elements in Array$πππ' ------ Display the listππ    ' ------ Are there more display rows than elements?π    IF Rows > Elements THENπ       Rows = Elements                  ' reduce displayed rowsπ       FOR i = Rows TO Table.Rows       ' blank out extra rowsπ      LOCATE i + TopRow - 1, Table.LColπ      PRINT STRING$(Table.MaxLen, 32);π       NEXT iπ    END IFππ    ' ------ Are there more elements than display rows?π    IF Elements > Table.Rows AND Action = 0 THENπ      LastPtrRow = BotRowπ      Ptr = -1π      RSide$ = CHR$(176)π      FOR i = 1 TO Rowsπ    LOCATE i + TopRow - 1, Table.LCol + Table.MaxLenπ    PRINT RSide$;π      NEXT iπ    ELSEπ      RSide$ = CHR$(179)π      Ptr = 0π    END IFπ   π    GOSUB ScrollππIF Action = 0 THENπ  Ptr = -1π  LOCATE Table.CurRow, Table.LCol + Table.MaxLenπ  PRINT CHR$(17);πEND IFππDO WHILE Action = 0π  k$ = INKEY$π π  SELECT CASE LEN(k$)π    CASE 0π      KeyCode = 0π      x = 0π    CASE 1π      KeyCode = ASC(k$)π    CASE 2π      KeyCode = ASC(RIGHT$(k$, 1))π  END SELECTππ  SELECT CASE KeyCodeπ    CASE 27                             'ESCπ      IF Wnd = 4 OR Wnd = 5 THEN        'if in Subs/Func screen return toπ    Wnd = 10                        'main screenπ      ELSE                              'elseπ    Wnd = -1                        '  exit programπ      END IFπ      EXIT SUBπ    π    CASE 13                             'ENTERπ       π    ' ------ Erase pointer in current windowπ    LOCATE LastCurRow, Table.LColπ    Temp$ = Array$(LastCh)π    Temp$ = Temp$ + SPACE$(Table.MaxLen - LEN(Temp$)) + CHR$(176)π    PRINT Temp$;π     π      IF Wnd = 1 THEN Wnd = 10          'based on active Windowπ      IF Wnd = 2 THEN Wnd = 20          'select actions to followπ      IF Wnd = 3 THEN Wnd = 30π      IF Wnd = 4 THEN Wnd = 40π      IF Wnd = 5 THEN Wnd = 50π      EXIT SUBππ    CASE 9                              'TABππ    ' ------ Erase pointer in current windowπ    LOCATE LastCurRow, Table.LColπ    Temp$ = Array$(LastCh)π    Temp$ = Temp$ + SPACE$(Table.MaxLen - LEN(Temp$)) + CHR$(176)π    PRINT Temp$;π     π      IF Wnd = 1 THEN                  'based on active Windowπ    Wnd = 2                        ' move to next Windowπ    EXIT SUBπ      ELSEIF Wnd = 2 THENπ    Wnd = 3π    EXIT SUBπ      ELSEIF Wnd = 3 THENπ    Wnd = 1π    EXIT SUBπ      ELSEIF Wnd = 4 THENπ    Wnd = 5π    EXIT SUBπ      ELSEIF Wnd = 5 THENπ    Wnd = 4π    EXIT SUBπ      END IFππ    CASE 72                             ' up  arrowπ      x = -1π    CASE 80                             ' down arrowπ      x = 1π  END SELECTππ  ' ------ Handle the direction keysπ  IF x THENπ    Table.Choice = Table.Choice + xππ    ' ------ Make sure choice is within array rangeπ    IF Table.Choice > Elements THENπ      BEEPπ      Table.Choice = Elementsπ    END IFπ    IF Table.Choice < 1 THENπ      BEEPπ      Table.Choice = 1π    END IFπ    IF Table.Choice > Table.TopEl + Rows - 1 THENπ      Table.TopEl = Table.TopEl + xπ    END IFπ    IF Table.Choice < LastCh AND Table.TopEl = LastCh THENπ      Table.TopEl = Table.Choiceπ    END IFππ    IF Table.Choice <> LastCh THENπ      GOSUB Scrollπ    END IFπ  END IFπLOOPππEXIT SUBππScroll:ππ' ------ Print arrayπLOCATE , , 0                            ' turn off the cursorππ' ------ Determine the Current display rowππTable.CurRow = TopRow + Table.Choice - Table.TopElππFOR i = 1 TO Rowsπ  LOCATE TopRow + i - 1, Table.LColπ  Temp$ = Array$(Table.TopEl + i - 1)π  Temp$ = Temp$ + SPACE$(Table.MaxLen - LEN(Temp$))π  PRINT Temp$πNEXT iππ' ------ If there's a pointer, display itπIF Ptr THENπ  π  ' ------ Erase the previous pointer, if the row is still in rangeπ  LOCATE LastCurRow, Table.LColπ  Temp$ = Array$(LastCh)π  Temp$ = Temp$ + SPACE$(Table.MaxLen - LEN(Temp$)) + CHR$(176)π  PRINT Temp$;ππ  '------ Draw the new pointerπ  LOCATE Table.CurRow, Table.LCol + Table.MaxLenπ  PRINT CHR$(17);π  LastCurRow = Table.CurRowππEND IFπ π' ------ Highlight the current array choiceπCOLOR BGColor, FGColor                  ' reverse colors for hi-lightπLOCATE Table.CurRow, Table.LColπTemp$ = Array$(Table.Choice)πTemp$ = Temp$ + SPACE$(Table.MaxLen - LEN(Temp$))πPRINT Temp$πLastCh = Table.ChoiceπLOCATE Table.CurRow, Table.LColπCOLOR FGColor, BGColor                  ' reset colorsππRETURNππEND SUBππSUB SelectDir (Wnd)π'***************************************************************************π'* SUB:         SelectDirπ'*                Changes to the directory chosen by the userπ'*π'* PARAMETERS:  Wnd     Active window numberπ'***************************************************************************ππIF DirNames$(DirLst.Choice) = ".       " THEN    ' force change to parentπ     SHELL "cd .."πELSEπ     DosCom$ = "cd " + DirNames$(DirLst.Choice)  ' change to new directoryπ     SHELL DosCom$πEND IFππCALL GetCurrPathπCALL InitDirsπCALL InitFilesπCALL GetDirNames(CurrDir$)πCALL GetFiles(CurrDir$)ππWnd = 2πππEND SUBππSUB SelectDrv (Wnd)π'**************************************************************************π'* SUB:         SelectDrvπ'*                Changes to the selected driveπ'*π'* PARAMETERS:  Wnd     Active windowπ'**************************************************************************ππ    SELECT CASE DrvLst.Choiceπ      CASE 1π        LOCATE 7, 10π        COLOR 7, 4π        BEEPπ        PRINT "Please insert Diskette in Drive A. ";π        PRINT "Press any key to continue..."π        COLOR FGColor, BGColorπ        BEEPπ        WHILE INKEY$ = "": WENDπ        SHELL "a:"π      CASE 2π        LOCATE 7, 10π        COLOR 7, 4π        BEEPπ        PRINT "Please insert Diskette in Drive B. ";π        PRINT "Press any key to continue..."π        COLOR FGColor, BGColorπ        BEEPπ        WHILE INKEY$ = "": WENDπ        SHELL "b:"π      CASE 3π        SHELL "c:"π      CASE 4π        SHELL "d:"π      CASE 5π        SHELL "e:"π    END SELECTππ    CALL GetCurrPathπ    CALL GetDirNames(CurrDir$)π    CALL GetFiles(CurrDir$)π    CALL InitDirsπ    CALL InitFilesπ    CALL ScrollLst(DirNames$(), DirLst, 1, 2)π    CALL ScrollLst(FileNames$(), FileLst, 1, 3)π    Wnd = 2ππEND SUBππSUB SelectFile (FileName$)π'**************************************************************************π'* SUB          SelectFileπ'*                  Reads SUB and FUNCTION names from the user selectedπ'*                  file into the appropriate arrays.π'*π'* PARAMETERS:  FileName$   Name of user selected fileπ'*π'* SHARED:      Subs$()π'*              Funcs$()π'**************************************************************************ππREDIM Subs$(50), Funcs$(50)ππOPEN FileName$ FOR INPUT AS #1π     πi = 1                                   'counter for SUB arrayπj = 1                                   'counter for FUNCTION arrayππ' -------- Assign MAIN as first name of SUB's arrayπSubs$(1) = "MAIN MODULE ONLY"πi = 2ππ' --------  Search for SUB and FUNCTION names.  These are assignedπ'           to arrays and displayed on the screen.ππDO UNTIL EOF(1)π  LINE INPUT #1, LineBuffer$ππ  FoundSub = INSTR(LineBuffer$, "DECLARE SUB")π  FoundFunc = INSTR(LineBuffer$, "DECLARE FUNCTION")ππ  IF FoundSub > 0 AND LEFT$(LineBuffer$, 7) = "DECLARE" THENπ    FOR k = 13 TO LEN(LineBuffer$)π      Char$ = MID$(LineBuffer$, k, 1)π      IF Char$ <> " " THENπ    SubName$ = SubName$ + Char$π      ELSEπ    EXIT FORπ      END IFπ    NEXT kπ    Subs$(i) = SubName$π    i = i + 1π    SubName$ = ""π  END IFππ  IF FoundFunc > 0 AND LEFT$(LineBuffer$, 7) = "DECLARE" THENπ    FOR k = 18 TO LEN(LineBuffer$)π      Char$ = MID$(LineBuffer$, k, 1)π      IF Char$ <> " " THENπ    FuncName$ = FuncName$ + Char$π      ELSEπ    EXIT FORπ      END IFπ    NEXT kπ    Funcs$(j) = FuncName$π    j = j + 1π    FuncName$ = ""π  END IFππLOOPππCLOSE #1ππEND SUBππEthan Winer                    CREATE/MODIFY DBF FILES        PC Magazine BASIC Techniques   Year of 1992           QB, PDS                123  8118     DBF.BAS     '>>> Page 1 of DBF.ZIP begins here. TYPE:BINAA TLEN:5737πDEFINT A-Z:DIM SHARED K,S,B&,Z&:V1 'Created by PostIt! 7.1πSUB V1:OPEN "O",1,"DBF.ZIP",4^6:Z&=5737:?STRING$(50,177);πU"%up()%9%%%%-%(uB&=DQ=CD$)7%%]5%%%1%%%%ig%fhhj%xxSgRfxF&9Xt\k^5MπU"l[/N=#S*Q_i]+^goJ7CAx%bz:f*XhZMfXMRmq.K]AAubqh4jX4-(_lTwn\pjm*YπU"F7r5MEEE5hKE-xRfUmKmdqLW0Ipp0Q4vEjd<J;kW>MF/Ah<Uj6HR=,S436/j=:AπU".Y54\r*\rXdHX7;zOd7f/fHB?(H(t5e$X6Ti6TcT:7-.;MmsWi3?XiRDDHb5qk8πU"[6jg]PO&,(B;dePb0lN5'']p&CDC>7>O0(pp_5T&<BM4h8-v3E-<,l1h-k]u;&ZπU"02B1oJ5#5L4ur0[KxXgdD[*\Zd<0U'/#WsA0*<VG52>Xd8i+ZTb??hOj#?6f9>OπU"aM#^covshiPrh]0O2)j:k#QEqeFJv3sh,f>c'm&W/R_)?x4_UZ4L[1cN./Mlo3(πU"J&:L>YuJ]^2d5R]<I%gPYkw/TUefa%1A+vR0B6vk4*n0RAJ:]B4_B]evn/PnY3CπU"htG-1)VQl<o%4<U=;_[F;Q%9<uBRIs=:RjI<WYEYa?-hRKH$[p0kZ#N1>.cqfK8πU"gM2gjmet(JXJu3c[fp]7KqkK)-V+dn^m9+87g[W'k=D&=_3Qe*7D9VD_/]WBbLZπU"#Uwk;TX%G-W05i&4)tF8CpZA8AWYX76uuUkZ9_3QD[=lU<98?*M/cUhF;K_O+g%πU"'LjDqpn/TI]qYj\Abot8Ag$;s_/''P9y?I^<j)*nTG.W.nW8#QU)8#5THLPEzk:πU"3<YgZAvOefayjt/DzKIh[qa^GZRP=XYi+_ZoqE5g*NNmakoI7H6DQ*S/_IFdmJgπU"6#o^>w_sn:Y^cNN8FpAM[fS1V'^v5YgJCxMT6kt.lneRl8aF6;K,'U8(39Dt.1'πU"X7#)/DguYcU:j4=5Z/cPxGpUYMYv_q9*VMp0kG)b6Q9Dn+z_T1\u.pw9.AJ<zpFπU"eIjrO%MVz)BC76DoNXARMbBhUO?7z;G%??UjdWNW_yRZ<h\WsGFHm*pNLZG/FrDπU"z.tHPD8M>A>H0QMDzc*Op.?1Rf/D&dW#KO=&P,TSB3_Hy;<nv]L5SvJ7nF]KTGVπU"JVQUC]j-h9O>r'0xbt,.6q$q61F/=NZZ0rFAEHKZC6+<0B%,qh\BxW&b\(S2yT7πU"zHeIal^IejF+(]wCX=s$G3D-i2M,:r5JNdI3$h-YNEJ*S.qFwbOU2%f]gls9)RMπU"Bgf4pRMD%adyzr^OJfgy'\-jS:-coTwgAh:HO:rC,$GVPGI'b>-4%'pKNz8OO.YπU"*83zl,vaCoNH7-AXjR'WG3ncSa3SuJI.3PnfTei4E)/c]G)IP]A=ez&9mD\;>%MπU"j+o(?,=k[MT:W9PXxRLxGVLfK.6X:Vju89PJMW6eDcVdk,.)tRcO0Ze/z?.xKV1πU"9$u&d^[3%*9Q5L88[*JPvCn]V/DMWJ#u:iSPusQE/*RgF-]51jI9c#;=3K88J;*πU"U,W>>BsC6?u(j4fx^\oPp6'c&rIzBVK01]?iQYcRyPX=;uQPPE>0&dA?6\tNXs:πU"NGAKugz'5^bT-$M*efWbl/7BscXMFqBWvLK:iO%PFO09P)TrNnD4=q&xepls9_*πU"+D^dCCAS;\qT3QO)7[('<ujr'R\ouUUkew.#_U3^XDd9N%&up(%)9%%%%-%(Fu&πU"=yk;dg3#'%%)%,%%1%%%%i%ghwj%fyjS[gfx6Lz*^i.e9ML0Zdkug8t4Fu3BWP%πU"K_1N(N]#>FxT\Y',P.<_R;?x>L$;-4P'LPdc]kT<pL$1sXvHF+(g9RriS[Z8C7;πU"*0=JZO3/RW$(aGnwe5?uJOl>E.4K(j/F+*2rcttP9oNKCZ:la,wtS1Qlp.TB>pTπU"hIl../eS)MOcTpYksv,2\)FUAUC2%?M-r^HgHG7)Aw#:.2Y8I1cH-Ow)?-f*waCπU"Dr[bO0nM--b.pq<3pG'mI<(<A09?)[b[Z7a%\qq(X3JUGV'MZ0-u>W2:q+ibCN3πU"SqWXp_>WR>w&l5iU)tC6\Q*MbP>Hcb\Gs?<ac#sg'-]r9y*N$T7\sZHL6*mzO5/πU"d1qYsRw).XJ=Hna*w'4Tw15CUB%^*#a=&lcds[ij>BtmhX7>7eO:fMd38_+8nu\πU"D#=mdKl[u&CuWf)];uJe%Y4R/v>12G%qbP-Q4wc4l0b6aM2rCun/ey;2mzFK[%rπU"ykV5VT(G.pnVkcmCCC1.#0Z_P%#TUazveT:%jAa31v>dA-YP(I]w,&5QPAK)C*hπU"K]R24a7l)#eD'6_O5tp]-ImJA2V,qnDWJ(nGK#dJ'/K.pjgvoW&:;E\8g6VIO#7πU"Y,h*RD]ju:CUEmb$:BLIiD:xdE5%,=v5g)Cc[[KR\0>?cbH]Vw:TgMardds]4r5πU":.$XGM#X/nHPHds]>Y(-'(tq97Zv(7>2OqG.]C\V.==IfpDCWWWlO(HHidw4AVnπU"<)xFxl7Gtuu0Zd'\jLFi>dn;t)grrgf._/+;eNMOt$YxPb0%=)9n_jrwX-pEKS=πU"sHvHww?O:3^*_$UjBvr:s>pYK/E,rf<,3Ib4Kxk$>H(7cYLE8Gj^B%Y.'eKk'CvπU",-dS^jy+<Lmu2LG=l)c$UxkZN%&up(%)9%%%%-%(Fu&=8%wZ3Z%(%%H%.%%/%%%πU"%i%gjin%ySgfOx>%,)>jo58Ll[d;[_hZH-=OL;ZlWP##;,X;O:)wNn\gD\[iE;VπU"'XxLhFE(9^;x?.pwH)oZ\EpkD(^dC[D]0[5Gj3VG^Y/7,iN,mqoqT+[oFPQrS(1πU")3DAyOnyW/D0$xdbrg:I0p+'PPqnPMtqsOt%&o:gA*[If1<lzh1ack'T0X]3/6\πU"m0\YHA?f5VBEpd4,#<bS6$1&tnoPb/wUDr1Xcc01zdZ*:*\<5JVQ]F)DekPjJ+qπU"=y>oHXzj6O8O<%[LV7swPh7X[U(Y]X%sfXv>N9OH4zj++>][.S8^qIKei&.Y=8=πU"0Idu:7JQe),Mn3U/J(yT)38GS0dEpL-nG8:SC5z,1[2$h,1DUP':;m;M#-&_[>BπU"b'\0'$cR1.3-]tfxWO>[\[pq7HrJ$hc.UJA5&p)E#JOCfjyUaim9\>?IgpnC28.πU"v'k-Tndvh,[S%4a:k<;yCFo_;0i>6#H_IA3F\8rrQU98,iDvx..h^(<u]XeH[#8πU"$+JmC6QYThm$XaDb;?X,e\F2)oXB')ifTg1h/jcjmj-1;$/'>jir'#8J88ImFhJπU"?*d+JA&DV>tLDum98kFI/5LV0+TGwc_34Mb$[uDkNc>TK7Z=k2q'>?RXt?hSCq_πU"188%t^JV>tOh7cJdb/TBA<>Y\L(<&uS1T2F*q)RJoe+0a0-A_E5*[=8s()(V:[PπU"1s)^_IVSqXIIrx.&\.StDq-Ynx&kF_ZVq#J4.H((aiu;<r890\uf/rP01a:D(+cπU"slm/mU%6c/SK_f*fk]^&OeH.ke*ikLLAU>OOZLoUlE$[_Z^;]Xf,Ro,q,;WWFu&πU"9t&ZmnH*KjXYmg\8nO1d>2d.GVCx,%L_Ti[_^6APE.bq9HIn%)wgq#az64?_(#%πU"Z0X>9'BY$T.49.OHD5-TOFIeyBm.]<d2RNJ2_yCnX<Kq+*/,S)-)4#BUX%EAJV,πU"LFj]T'Q$[Lmx/$R/-73ZCeG>g2KCN)P6I0\+2lx\o>^,,?Z_;8/A0'^*=Y5Riw<πU"PB<1[7C1EF.,zVi9OKd34RNWQ[Fid'h,up%()9%%%%-%7#w&=]Oy5E'R'%%&v*%πU"%%/%%%%iguf%hpSg.fx4y2,>jo^5Ll[Ld[7=O1&Z;2zyci<pPYJ:k#**mirt/PTπU".\Q$:)[*cuh$,>O834q76oEnh^<e.3cn;IqDfmHxecI(.K*NQ/nV7.E<tu#Gl$zπU">4W9oWO*YWC2/zcB;Yq2ZYP4R+QO#*tE_9q*g='q)<G*d&Zom2\X;N4DV4NGpH/πU"DX1)A3=++n/3cn4)0D6Sd1[zp&kN6yY9(29xYW)bn)6k&Zq,oPpzI;ma2B*1F+QπU":7e>a2e0.1^r%#<=?>ZlliQdsm.\RJ*XS5*HFrTnB-5CFN3'TMT3+0:PW%knlj>πU"D^8zpsAuQ-rs95(8G$oK[?urD9Bn3uc]t=3'qlmh,=IrpIn5tb(CJ:4_aZu&*/'πU"<\79+&uRM7sVlJ7t5Q0$ga#N,_$/hxh8=e[sR+H.fVs#0=$S[0/voOMLgVC6RU)πU"i7s/*m/x-V9KBNdPq[*#j4O_qXHUXg.k=/ika?EhU?Q^)+3u4H(m6QWd2]qJ5HUπU"MfI=?e8E)7/0OerL>:cV>sLyG/^Lt(UlH+ZnR]\ue%9x2jK4pH6\hEZBJ%d<:g,πU"mc_lPr2tIdMG'=QQ,[;*VUSEdJ5ds%Iyp/hgnOs7pnsGL-Tqrmj/LoOKu6F45$wπU"=Ce:nII[wByB^plMXsd-00$*.)WI#XxkW6us^3tY6mo;RT9Nuo<F6<<z::$RLl/πU"H?R:KshA#fF#y^=No6tq/s,Qq?mK6#[7M4c.48B\5-0d?.2H?$w/yFoU2xcd6GHπU"ZfeT7:YQL?.YgM9\h%z<A-;o>;G&pNNq$QR>?G5Y2\xX8;VQPg;8hLjd'#-^SffπU"wz5m7zZk7L[YKHfFx=c/%#E5_K-Q7hcL1$j7jsBZROQb)M(g\qjK;22nmpS23ohπU"e&e#uP_c6fU0IDim2i0V^vn?MEp)QFHb('PW^TM]r_/D+Yw'u%p()9%%%%-[%ruπU"&d=qQh,=h&%%%V)%%%1%%%%igx%ywzh%ySgfLxTa,)^ie9bUhnq:4>Iit7N'6J*πU"[Jp(U3n5p\O&fTVi#d[i,(,X<wtmI&i99R_\EHTHX$bWJfTPT8m,3rf4L>aa>)4πU"]5_Dr)tQ_-pyyuUGyHwo*QR8?D/nDTq8g?A4PGfW]x]MQn*,,$l$h/cf9JM_^wcπU"?j8(5?>W_bXSX4<QZ0OcBV8qULja]3<$tm#K-6jM^6?A%EtFhQc&pGct;0:PqQCπU".fhjSYCWC/VCSp95.78^Jw6C)p\y\\/?.LuWYQQ9o1R/.XlBfgS]&C+Y5MZ/\M[πU">Q;qLl*:1wvIabY:<h_uIh+'2&E=CDi%k=5tO*R&8g1:9bh1n_6c*QYIfJIEPN(πU"S$0Jh+ZLeSf,;:aY)_#0n3JGEDW=nj#XSiI,JJ^O4=E?mLpib^Totap,MBl&IiaπU"Apdi(N^TCpY^nKuPg/AVFj5w'DnFY<V&2f-0e;.;IwBkfO3xub]WVc8<uVqJkGbπU"C=:%XQ;l^'Ax\yQH.'cEW54.rp3A=DGhNM-wINBDsMSwkfU6KKIw$-+P4Ykdh9lπU"8(SKf0Kb7O2YZ<tM[#CccWraq7.xtih*<b.J)z)j#5qw4Bhz'ti9V/X\G--6\qPπU"t=<uAl.raAve&4+MVr8=;=h,r(%up()%9%%%%-%(u'&=Gm(VUX&%%%;(%%%0%%%πU"%ig%fhhj%xxSg1nt$t,:;U=kVhQX]Zby&mh,TF_2i['IEz;4i)*e56L)gog?0MtπU"5t3Dz.a9epQw5>mBX8WI'qB5lbSKIHCDr9uJ_?p^F7Zh8[)v?#/dv50h+:_h7i-πU"%O\_MY0rUxKmYJvWW2eVbz3TlRu5[Z8[qJU=fN1P&4HIOR#?;K%%pWL4e<aQ%8'πU"A\6u),%=l71g_H6,\M''>?jZXAXm(u]'NABp=qOn8n%^)v?1I^,uuDlURr1]2alπU"$hhtd&p9NY$<ZHZPOCoQ+,q&fc>uWUhdR47'_D*_pC.lZBGC$?S\\8PiED,CIa.πU"dqsWHRx/;;bJGq,5)[9[Xodm5eQC>9ClDrnofWQVrYBo7[i_YMJrj.#g[?+BCfHπU"kA(8>kt=)O;b:w';\>t+%up()%9%%%%-%ru]&=jT;gHa%7%%T&%%%+%%%%ig%kSπU"gnYDHF=';U5)iYJs5Q<U7$;)dW]=glLm:5y=OZ[aSjmK7QAU[V5L3fwqG;pJuYtπU"-hE_MNR3l+b(0aJpGp\eSI#],U4sP\Zk#1SeE8%:g_.U-s[_jU[][7rouH6Qb7*πU"Vj,jW>kArYMi.+0h[HKiQ'ZH2df58f.%X<6l]9L>d00(z?=jBKaf&'>bSs6_e=4πU"=FBrW9^SmNL5#;lCO><dK:67Xto\Q6RdH%Ut#w\b2Qd9aMfR2v4Qu3j)D-2,Z5JπU".dvGuE,yMB6E*G>Ykn$$O45:i?BZ<Rqr]7#;NFu%%up()%/%%%#%%%oB?;i%)X$πU"A%%%%A%%%%1%%%%ig%hwjf%yjSr%fpig%hwjf%yjSg%fx2/%igfh%hjxx%Sgfx%πU"2/up%()/%%%%%%:%o?;?9%wc%?%%%%?%%%%/%%%%igji%nySr%fpig%jiny%SgfπU"x%2/ig%fhhj%xxSg%fx2/%up()%/%%%#%%%o0?;O6)Jq?%%%%?%%%%/%%%%ig%uπU"fhp%Srfp%iguf%hpSg%fx2/%igfh%hjxx%Sgfx%2/up%()/%%%%%%*k1:<,Kdr,πU"%A%%%%A%%%%1%%%%igxy%wzhy%Srfp%igxy%wzhy%Sgfx%2/ig%fhhj%xxSg%fxπU"2/%up&'%9%9%%%%-%7(u&=^DQCD'$)%%']5%%%1%%%%%%%%%&%E%%%%%%%%%ig%πU"fhhj%xxSg%fxup%&'9%%9%%%%-%(uK&=y;<dg3'.%%),%%%1%%%%%%%%%&%%E%%πU"%%6*%%%ighw%jfyj%Sgfx%up&'%9%9%%%%-%7(u&=&8wZ3%Z(%%%H.%%%/%%%%%πU"%%%%&%E%7%%n,%%%ig%jiny%Sgfx%up&'%9%9%%%%-%7#w&=]Oy5E'R'%%&v*%%πU"%/%%%%%%%%%&%E%%%%w0%%%ig%ufhp%Sgfx%up&'%9%9%%%%-%7ru&=UqQh='h&πU"%%%V)%%%1%%%%%%%%%&%E%%%%x3%%%ig%xywz%hySg%fxup%&'9%%9%%%%-%(u'πU"&=Gm(VUX&%%%;(%%%0%%%%%%%%%&%%E%%%&;5%%%igfh%hjxx%Sgnu%p&'9%%9%πU"%%%-%r+u&=jiTgHa[%%%T%&%%+%%%%%%%%%&%%E%%+%A6%%%igk%Sgnu%p&'9%%πU"/%%%%%%%,o?;i2%X$A%%%%A%%%%1%%%%%%%%%&%%E%%+%M7%%%igh%wjfy%jSrfπU"%pup&%'9%/%%%%%d%%o?s;9%w%c?%%%%?%%%%/%%%%%%%%%&%E%%%%?%8%%i%gjπU"in%ySrf%pup&%'9%/%%%%%d%%o?C;O6J&q?%%%%?%%%%/%%%%%%%%%&%E#%%%+%πU"8%%i%gufh%pSrf%pup&%'9%/%%%%%4%k1::<Kdr%,A%%%%A%%%%1%%%%%%%%%&%πU"E#%%%m%8%%i%gxyw%zhyS%rfpu%p*+%%%%%0#%0%>['%%]%8%%%%%πEND SUBπCLOSE:IF S=249AND B&=Z&THEN?" :) Ok!"ELSE?" :( Bad!πSUB U(A$):FOR A=1TO LEN(A$):C=ASC(MID$(A$,A))-37:IF C<0THEN C=91+C*32πIF K<4THEN K=C+243ELSE?#1,CHR$(C+(K MOD 3)*86);:K=K\3:B&=B&+1πS=(S+C)AND 255:NEXT:LOCATE,1:?STRING$(B&*50\Z&,219);:END SUBπ'>>> Page 1 of DBF.ZIP ends here. Last page. TCHK:249πEthan Winer                    READ/WRITE LOTUS 123 FILES     BASIC Techniques               Year of 1992           QB, QBasic, PDS        254  8121     LOTUS123.BAS'*********** LOTUS123.BAS - shows how to read and write Lotus 1-2-3 filesππ'Copyright (c) 1992 Ethan WinerππDEFINT A-ZπDECLARE SUB GetFormat (Format, Row, Column)πDECLARE SUB WriteColWidth (Column, ColWidth)πDECLARE SUB WriteInteger (Row, Column, ColWidth, Temp)πDECLARE SUB WriteLabel (Row, Column, ColWidth, Msg$)πDECLARE SUB WriteNumber (Row, Col, ColWidth, Fmt$, Num#)ππDIM SHARED CellFmt AS STRING * 1        'to read one byteπDIM SHARED ColNum(40)                   'max columns to writeπDIM SHARED FileNum                      'the file number to useππCLSπPRINT "Read an existing 123 file or ";πPRINT "Create a sample file (R/C)? ";πLOCATE , , 1πDOπ   X$ = UCASE$(INKEY$)πLOOP UNTIL X$ = "R" OR X$ = "C"πLOCATE , , 0πPRINT X$ππIF X$ = "R" THENππ  '----- read an existing fileπ  INPUT "Lotus file to read: ", FileName$π  IF INSTR(FileName$, ".") = 0 THENπ    FileName$ = FileName$ + ".WKS"π  END IFπ  PRINTππ  '----- get the next file number and open the fileπ  FileNum = FREEFILEπ  OPEN FileName$ FOR BINARY AS #FileNumππ  DO UNTIL Opcode = 1                   'until End of File codeππ     GET FileNum, , Opcode              'get the next opcodeπ     GET FileNum, , Length              'and the data lengthππ     SELECT CASE Opcode                 'filter the Opcodesππ    CASE 0                              'Beginning of File recordπ      PRINT "Beginning of file, Lotus ";π      GET FileNum, , Tempππ      SELECT CASE Tempπ        CASE 1028π          PRINT "1-2-3 version 1.0 or 1A"π        CASE 1029π          PRINT "Symphony version 1.0"π        CASE 1030π          PRINT "123 version 2.x"π        CASE ELSEπ          PRINT "NOT a Lotus File!"π      END SELECTππ    CASE 1                                  'End of Fileπ      PRINT "End of File"ππ    CASE 12                                 'Blank cellπ       'Note that Lotus saves blank cells only if they are formatted orπ       'protected.π       CALL GetFormat(Format, Row, Column)π       PRINT "Blank:      Format ="; Format,π       PRINT "Row ="; Row,π       PRINT "Col ="; Columnππ    CASE 13                                 'Integerπ       CALL GetFormat(Format, Row, Column)π       GET FileNum, , Tempπ       PRINT "Integer:    Format ="; Format,π       PRINT "Row ="; Row,π       PRINT "Col ="; Column,π       PRINT "Value ="; Tempππ    CASE 14                                 'Floating pointπ       CALL GetFormat(Format, Row, Column)π       GET FileNum, , Number#π       PRINT "Number:     Format ="; Format,π       PRINT "Row ="; Row,π       PRINT "Col ="; Column,π       PRINT "Value ="; Number#ππ    CASE 15                                 'Labelπ       CALL GetFormat(Format, Row, Column)π       'Create a string to hold the label.  6 is subtracted to exclude theπ       'Format, Column, and Row information.ππ       Info$ = SPACE$(Length - 6)π       GET FileNum, , Info$                 'read the labelπ       GET FileNum, , CellFmt$              'eat the CHR$(0)π       PRINT "Label:      Format ="; Format,π       PRINT "Row ="; Row,π       PRINT "Col ="; Column, Info$ππ    CASE 16                                 'Formulaπ       CALL GetFormat(Format, Row, Column)π       GET FileNum, , Number#               'read cell valueπ       GET FileNum, , Length                'and formula lengthπ       SEEK FileNum, SEEK(FileNum) + Length 'skip formulaπ       PRINT "Formula:    Format ="; Format,π       PRINT "Row ="; Row,π       PRINT "Col ="; Column,π       PRINT "Value ="; Number#ππ    CASE ELSEπ       Dummy$ = SPACE$(Length)              'skip the recordπ       GET FileNum, , Dummy$                'read it inπ       PRINT "Opcode: "; Opcode             'show its Opcodeππ     END SELECTππ     '----- pause when the screen fillsπ     IF CSRLIN > 21 THENπ       PRINTπ       PRINT "Press <ESC> to end or ";π       PRINT "any other key for more"π       DOπ         K$ = INKEY$π       LOOP UNTIL LEN(K$)π       IF K$ = CHR$(27) THEN EXIT DOπ       CLSπ     END IFππ     NumRecs = NumRecs + 1                  'count the recordsππ  LOOPπ  PRINT "Number of Records Processed ="; NumRecsπ  CLOSEππELSEππ  '----- write a sample fileπ  FileNum = FREEFILE                        'as aboveπ  OPEN "SAMPLE.WKS" FOR BINARY AS #FileNumππ  Temp = 0                                  'OpCode for Start of Fileπ  PUT FileNum, , Temp                       'write thatπ  Temp = 2                                  'its data length is 2π  PUT FileNum, , Temp                       'since it's an integerπ  Temp = 1030                               'Lotus version 2.xπ  PUT FileNum, , Tempππ  Row = 0                                   'write this in Row 1π  DOπ     CALL WriteLabel(Row, 0, 16, "This is a Label")π     CALL WriteLabel(Row, 1, 12, "So is this")π     CALL WriteInteger(Row, 2, 7, 12345)π     CALL WriteNumber(Row, 3, 9, "C2", 57.23#)π     CALL WriteNumber(Row, 4, 9, "F5", 12.3456789#)π     CALL WriteInteger(Row, 6, 9, 99)       'skip a column for funπ     Row = Row + 1                          'go on to the next rowπ  LOOP WHILE Row < 6ππ  '----- Write the End of File record and close the fileπ  Temp = 1                                  'Opcode for End of Fileπ  PUT FileNum, , Tempπ  Temp = 0                                  'the data length is zeroπ  PUT FileNum, , Tempπ  CLOSEππEND IFπENDππSUB GetFormat (Format, Row, Column) STATICπ  GET FileNum, , CellFmt$: Format = ASC(CellFmt$)π  GET FileNum, , Columnπ  GET FileNum, , RowπEND SUBππSUB WriteColWidth (Column, ColWidth) STATICππ  '----- allow a column width only once for each columnπ  IF NOT ColNum(Column) THENπ    Temp = 8π    PUT FileNum, , Tempπ    Temp = 3π    PUT FileNum, , Tempπ    PUT FileNum, , Columnπ    Temp$ = CHR$(ColWidth)π    PUT FileNum, , Temp$π    '----- show we wrote this column's widthπ    ColNum(Column) = -1π  END IFππEND SUBππSUB WriteInteger (Row, Column, ColWidth, Integ) STATICππ  Temp = 13                                 'OpCode for an integerπ  PUT FileNum, , Tempπ  Temp = 7                                  'Length + 5 byte headerπ  PUT FileNum, , Tempπ  Temp$ = CHR$(127)                         'the format portionπ  PUT FileNum, , Temp$π  PUT FileNum, , Columnπ  PUT FileNum, , Rowπ  PUT FileNum, , Integπ  CALL WriteColWidth(Column, ColWidth)ππEND SUBππSUB WriteLabel (Row, Column, ColWidth, Msg$)ππ  IF LEN(Msg$) > 240 THEN                   '240 is the maximum lengthπ    Msg$ = LEFT$(Msg$, 240)π  END IFππ  Temp = 15                                 'OpCode for a labelπ  PUT FileNum, , Tempπ  Temp = LEN(Msg$) + 7                      'Length plus 5-byte headerπ                                            'plus "'" plus CHR$(0)π  PUT FileNum, , Tempπ  Temp$ = CHR$(127)                         '127 is the default formatπ  PUT FileNum, , Temp$π  PUT FileNum, , Columnπ  PUT FileNum, , Rowπ  Temp$ = "'" + Msg$ + CHR$(0)              'a "'" left-aligns a labelπ                                            'use "^" instead to centerπ  PUT FileNum, , Temp$π  CALL WriteColWidth(Column, ColWidth)ππEND SUBππSUB WriteNumber (Row, Col, ColWidth, Fmt$, Num#) STATICππ  IF LEFT$(Fmt$, 1) = "F" THEN                    'fixedπ    '----- specify the number of decimal placesπ     Format$ = CHR$(0 + VAL(RIGHT$(Fmt$, 1)))π  ELSEIF LEFT$(Fmt$, 1) = "C" THEN                'currencyπ     Format$ = CHR$(32 + VAL(RIGHT$(Fmt$, 1)))π  ELSEIF LEFT$(Fmt$, 1) = "P" THEN                'percentπ     Format$ = CHR$(48 + VAL(RIGHT$(Fmt$, 1)))π  ELSE                                            'defaultπ     Format$ = CHR$(127)                    'use CHR$(255) for protectedπ  END IFππ  Temp = 14                                 'Opcode for a numberπ  PUT FileNum, , Tempπ  Temp = 13                                 'Length (8) + 5 = 13π  PUT FileNum, , Tempππ  PUT FileNum, , Format$π  PUT FileNum, , Colπ  PUT FileNum, , Rowπ  PUT FileNum, , Num#ππ  CALL WriteColWidth(Column, ColWidth)ππEND SUBπCoridon Henshaw                ACCESSING FOSSIL IN BASIC      QuickBASIC ScrapBook           02-14-93 (21:39)       QB, PDS                146  3225     FOSSIL.BAS  DECLARE FUNCTION FossInit% (Port%)πDECLARE FUNCTION BlockRead$ (Port%)πDECLARE FUNCTION BlockWrite% (Port%, Buffer$)πDEFINT A-Zπ π'$INCLUDE: 'QB.BI'    or use QBX.BI for PDSππDIM SHARED Regs AS RegTypeXππFUNCTION BlockRead$ (Port)πBuffer$ = STRING$(32766, 0) 'Max 32766 bytes to readπRegs.cx = LEN(Buffer$)πRegs.dx = PortπRegs.es = VARSEG(Buffer$)   ' Change to SSEG for PDSπRegs.di = SADD(Buffer$)πCALL INTERRUPTX(&H14, Regs, Regs)πBlockRead$ = LEFT$(Buffer$, Regs.ax)πEND FUNCTIONππFUNCTION BlockWrite (Port, Buffer$)πRegs.cx = LEN(Buffer$)πRegs.dx = PortπRegs.es = VARSEG(Buffer$)  ' Change to SSEG for PDSπRegs.di = SADD(Buffer$)πCALL INTERRUPTX(&H14, Regs, Regs)πBlockWrite = Regs.ax 'Number of chars transferedπEND FUNCTIONππSUB FossDeInit (Port)π' Release the FOSSIL device driverπRegs.ax = &H500πRegs.dx = PortπINTERRUPTX &H14, Regs, RegsπEND SUBππFUNCTION FossInit (Port)π π' Initialize the FOSSIL device driverπ'π' dx = Communications port number (0-3)π' ah = &H04    Fossil Function Number - Initialize FOSSIL driverπ'                                       (Raises DTR in the porcess)π πRegs.dx = PortπRegs.ax = &H400πCALL INTERRUPTX(&H14, Regs, Regs)π πIF Regs.ax <> &H1954 THENπ   FossInit = False 'Fossil Not FoundπEND IFπ πFossInit = Trueπ πEND FUNCTIONππSUB SetDtr (Port, DtrStatus)πRegs.dx = Port 'Set carrier detect low or highπSELECT CASE DtrStatusπ    CASE 0π    Regs.ax = &H600π    CASE 1π    Regs.ax = &H601π    CASE ELSEπ    Regs.ax = &H600π    BEEPπEND SELECTπINTERRUPTX &H14, Regs, RegsπEND SUBππSUB SetFlowControl (Port, Control)πRegs.dx = PortπSELECT CASE Controlπ CASE 1 'Xon/Xoff on transmitπ  Regs.ax = &H601π CASE 2 'CTS/RTSπ  Regs.ax = &H602π CASE 3 'Xon/Xoff on recieveπ  Regs.ax = &H608πEND SELECTπCALL INTERRUPTX(&H14, Regs, Regs)πEND SUBππSUB SetPortParams (Port, Bps AS LONG, Bits, Stops, Parity$)πRegs.dx = PortπRegs.ax = 0πSELECT CASE Bpsπ    CASE 300π    Regs.ax = (Regs.ax OR &H40)π    CASE 600π    Regs.ax = (Regs.ax OR &H60)π    CASE 1200π    Regs.ax = (Regs.ax OR &H80)π    CASE 2400π    Regs.ax = (Regs.ax OR &HA0)π    CASE 4800π    Regs.ax = (Regs.ax OR &HC0)π    CASE 9600π    Regs.ax = (Regs.ax OR &HE0)π    CASE 19200π    Regs.ax = (Regs.ax OR &H0)π    CASE 38400π    Regs.ax = (Regs.ax OR &H20)π    CASE ELSEπ    Regs.ax = (Regs.ax OR &HA0)π    'Default to 2400 baudπEND SELECTπ πSELECT CASE Bitsπ    CASE 5π    Regs.ax = (Regs.ax OR &H0)π    CASE 6π    Regs.ax = (Regs.ax OR &H1)π    CASE 7π    Regs.ax = (Regs.ax OR &H2)π    CASE 8π    Regs.ax = (Regs.ax OR &H3)π    CASE ELSEπ    Regs.ax = (Regs.ax OR &H3)π    'Default to 8 bitsπEND SELECTπ πSELECT CASE Stopsπ    CASE 1π    Regs.ax = (Regs.ax OR &H0)π    CASE 2π    Regs.ax = (Regs.ax OR &H4)π    CASE ELSEπ    Regs.ax = (Regs.ax OR &H0)π    'Default to 1 stop bitπEND SELECTπ πSELECT CASE UCASE$(Parity$)π    CASE "N"π    Regs.ax = (Regs.ax OR &H0)π    CASE "O"π    Regs.ax = (Regs.ax OR &H8)π    CASE "E"π    Regs.ax = (Regs.ax OR &H18)π    CASE ELSEπ    Regs.ax = (Regs.ax OR &H0)π    ' Default to no parityπEND SELECTπRegs.dx = PortπINTERRUPTX &H14, Regs, RegsπEND SUBππUnknown Author(s)              DETECTING CARRIER              FidoNet QUIK_BAS Echo          Unknown Date           QB, QBasic, PDS        18   763      DETCARR.BAS '>Looking for and example of code to monitor carrier detect. Would like toπ'>be able to have a local programer using Thorobred  add carrier detect toπ'>his program but he has never seen any code as to what to do. I know thereπ'>has to be someone in the Quick Basic world that can do this and hopefullyπ'>we can transfer this to another basic program. Any help appreciated.π π π DEFINT A-Zπ FUNCTION Carrier(Port) ' returns false (0) if no carrierπ Select Case Portπ    CASE 1: BaseAddress = &H3F8π    case 2: BaseAddress = &H2F8π    CASE 3: BaseAddress = &H3E8π    CASE 4: BaseAddress = &H2E8π    CASE ELSE: BaseAddress  = Portπ            'For Those PS/2 types out there or Weird onesπ End Selectπ Carrier = (INP(BaseAddress + 6) AND &h80) > 0πJames Vahn                     ALARM ON CONNECTION            FidoNet QUIK_BAS Echo          10-18-92 (10:18)       QB, QBasic, PDS        109  2703     CONNECT.BAS '>  Does anyone have code that allows you to dial a number throughπ'>  the modem, and allow the user to pick up the phone when itπ'>  connects (and things to watch for, like how do you know whenπ'>  it's safe to pick up the phone)?πππ' This routine sends an alarm when a connection is made.πππ'modem.bas  is an ASCII terminal to demo an autodialer.  James VahnπDECLARE SUB Keyscan ()πDECLARE SUB Delay (td!)πDECLARE SUB Dial (num$)ππ' Put all modem response into a 10k buffer declared global.πCOMMON SHARED ModemIn$ππON ERROR GOTO HandlerπON COM(2) GOSUB GetBufπCOM(2) ONππCALL Dial ("555-1212")ππDOπ CALL Keyscan      ' You're online now. Stay in this loop forever.πLOOPππHandler:πRESUME NEXTππGetBuf:πInStr$ = INPUT$(LOC(1), #1)ππ   ' swap a backspace char for a left cursor.π   DOπ      BackSpace = INSTR(InStr$, CHR$(8))π      IF BackSpace THENπ         MID$(InStr$, BackSpace) = CHR$(29)π      END IFπ   LOOP WHILE BackSpaceππ   ' eliminate line feeds.π   DOπ      LineFeed = INSTR(InStr$, CHR$(10))π      IF LineFeed THENπ         InStr$ = LEFT$(InStr$, LineFeed - 1) + MID$(InStr$, LineFeed + 1)π      END IFπ   LOOP WHILE LineFeedππ   ModemIn$ = RIGHT$(ModemIn$ + InStr$, 10240)π   PRINT (InStr$);            'print modem buffer to screen.πRETURNππSUB Delay (td!)π  TimeDelay! = (TIMER + td!) mod 86400π  WHILE TimeDelay! > TIMER: WENDπEND SUBππSUB Dial (num$)ππOPEN "COM2:2400,N,8,1" FOR RANDOM AS #1ππCLSπLOCATE 25, 40: PRINT "ALT-X to exit.."πLOCATE 1, 1, 1π  PRINT #1, "ATZ"π  CALL Delay(1.25)π  PRINT #1, "ATS7=45 S0=0 V1 M0"     ' modem initialization stringπ  CALL Delay(1.25)ππDOπ  CALL Delay(1)π  PRINT "Dialing ....."π  PRINT #1, "atdt" + Num$ + CHR$(13)ππ TimeDelay! = TIMER + 40ππ   DO UNTIL TIMER > TimeDelay!π       CALL Keyscanπ       test = INSTR(RIGHT$(ModemIn$, 20), "CONNECT")π        IF test THEN result = -1: EXIT DOπ       test = INSTR(RIGHT$(ModemIn$, 5), "BUSY")π        IF test THEN result = 0: EXIT DOπ       test = INSTR(RIGHT$(ModemIn$, 12), "NO DIALTONE")π        IF test THEN result = 0: CALL Delay(2): EXIT DOπ       test = INSTR(RIGHT$(ModemIn$, 11), "NO CARRIER")π        IF test THEN result = 0: CALL Delay(2): EXIT DOππ   LOOPππLOOP UNTIL resultππFOR t = 1 TO 5            ' It answered! ring the alarm!π  SOUND 750, 2π  SOUND 550, 2π  SOUND 650, 2π  IF INKEY$ <> "" THEN EXIT FORπNEXTππEND SUBππSUB Keyscanπ' This would be a good place to check for PgDn/PgUp and shell to anπ' external transfer protocol like Zmodem.ππa$ = INKEY$π    IF a$ = CHR$(0) + CHR$(45) THEN CLOSE : END '  ALT-X to exit.π    PRINT #1, a$;    ' send keypress to modemπEND SUBπDavid Colston                  BBS DICE DOOR GAME             FidoNet QUIK_BAS Echo          Year of 1993           QB, PDS                452  11136    DOORGAME.BAS'A local sysop wanted a door to roll dice for a dungeons and dragonsπ'game. I thought you might like to see it. Some of the code might lookπ'familar<g>. Not all of the fossil routines are used, but are offeredπ'for completeness.ππDECLARE SUB Delay (X!)πDECLARE SUB CheckPortStatus (Port%, Info%, Reg AS ANY)πDECLARE SUB FossInit (Port%, Present%, Reg AS ANY)πDECLARE SUB GetChar (Port%, Good%, InBound$, Present%, Reg AS ANY)πDECLARE SUB PrintCon (A$, Reg AS ANY)πDECLARE SUB SendChar (Port%, Sent%, Present%, Outbound$, Reg AS ANY)π' $INCLUDE: 'QBX.BI'π' Include Data Types for INπDEFINT A-Zπ'$STATICπDIM Reg AS RegType                ' Used for INTERRUPT callsπA# = TIMER + 120 'Allow only two minute in this doorπ                     'This saves us from constantly monitoringπ                     'carrier detect.πON TIMER(A#) GOSUB QuitπON KEY(10) GOSUB Quit'Allow local bail out by sysopπTIMER ONπKEY(10) ONπPort = VAL(LTRIM$(RTRIM$(COMMAND$)))' Port =0 is port 1, etc.πStart:πDIM Rolls(1000)πFossInit Port, Present, Reg 'Find out if fossil is present orπ                       'if we're just looking on a PC.πBits = 8   'Defaults for almost all boards!πStops = 1πParity$ = "N"πSendChar Port, Sent, Present, CHR$(12), Reg 'Just in case theyπ                                                            π'haveπX$ = CHR$(27) + "[2J   Dice Door 1.0 By David Colston (c) 1993"πX$ = X$ + CHR$(13) + CHR$(10)π'Send ansii clear screen and return; line feedπ πX$ = X$ + "   Enter your character name:"πFOR I = 1 TO LEN(X$)π    SendChar Port, Sent, Present, MID$(X$, I, 1), Regπ    PrintCon MID$(X$, I, 1), Reg'Echo to board consol.πNEXTπDOπ    GetChar Port, Good, InBound$, Present, Regπ    IF Good THENπ        IF InBound$ <> CHR$(13) THEN User$ = User$ + InBound$π        SendChar Port, Sent, Present, InBound$, Regπ        PrintCon InBound$, Regπ    END IFπLOOP UNTIL InBound$ = CHR$(13)πDiceSides:πX$ = CHR$(13) + CHR$(10) + "   Enter Number of Dice Sides:"πFOR I = 1 TO LEN(X$)π    SendChar Port, Sent, Present, MID$(X$, I, 1), Regπ    PrintCon MID$(X$, I, 1), RegπNEXTπSides$ = ""πDOπ    GetChar Port, Good, InBound$, Present, Regπ    IF Good THENπ        IF INSTR(1, "1234567890", InBound$) > 0 THENπ             Sides$ = Sides$ + InBound$π             SendChar Port, Sent, Present, InBound$, Regπ         END IFπ         PrintCon InBound$, Regπ     END IFπLOOP UNTIL InBound$ = CHR$(13)πIF VAL(Sides$) < 2 OR VAL(Sides$) > 100 THEN GOTO DiceSidesπDice:πX$ = CHR$(13) + CHR$(10) + "   Enter Number of Dice      :"πFOR I = 1 TO LEN(X$)π    SendChar Port, Sent, Present, MID$(X$, I, 1), Regπ    PrintCon MID$(X$, I, 1), RegπNEXTπDice$ = ""πDOπ     GetChar Port, Good, InBound$, Present, Regπ     IF Good THENπ         IF INSTR(1, "1234567890", InBound$) > 0 THENπ             Dice$ = Dice$ + InBound$π             SendChar Port, Sent, Present, InBound$, Regπ         END IFπ         PrintCon InBound$, Regπ      END IFπLOOP UNTIL InBound$ = CHR$(13)πIF VAL(Dice$) < 2 OR VAL(Dice$) > 100 THEN GOTO DiceπGrey = FREEFILEπOPEN "Greyhawk.rol" FOR APPEND AS Grey' Output for game bulletinπPRINT #Grey, "On "; DATE$; " "; User$; " had the following roll."πPRINT #Grey, "# Dice = "; Dice$; " # Sides = "; Sides$πRANDOMIZE TIMERπTotalRoll = 0πFOR I = 1 TO VAL(Dice$)π    Roll = INT(RND(1) * VAL(Sides$)) + 1π    X$ = CHR$(13) + CHR$(10) + "   Die" + STR$(I) + " Showed" + STR$(Roll)π    TotalRoll = TotalRoll + Rollπ    FOR J = 1 TO LEN(X$)π       SendChar Port, Sent, Present, MID$(X$, J, 1), Regπ       PrintCon MID$(X$, J, 1), Regπ    NEXTπ    PRINT #Grey, RIGHT$(X$, LEN(X$) - 2)πNEXTπX$ = CHR$(13) + CHR$(10) + "   Total Rolled Was" + STR$(TotalRoll)πPRINT #Grey, RIGHT$(X$, LEN(X$) - 2)πPRINT #Grey, SPACE$(10)πFOR J = 1 TO LEN(X$)π     SendChar Port, Sent, Present, MID$(X$, J, 1), Regπ     PrintCon MID$(X$, J, 1), RegπNEXTπSendChar Port, Sent, Present, CHR$(13), RegπX$ = CHR$(13) + CHR$(10) + "  Press any key."πFOR J = 1 TO LEN(X$)π     SendChar Port, Sent, Present, MID$(X$, J, 1), Regπ     PrintCon MID$(X$, J, 1), RegπNEXTπDOπ     GetChar Port, Good, InBound$, Present, Regπ     IF Good THEN PrintCon InBound$, RegπLOOP UNTIL GoodππQuit:πENDπ π'This door in not error trapped one of you guys might do better!ππSUB CheckPortStatus (Port, Info, Reg AS RegType)π π' ah = &H03     Fossil Function Number - Statusπ' al = &H00     Place Holderπ' dx = Communications port number       (0-3)πReg.dx = PortπReg.ax = &H300πINTERRUPT &H14, Reg, Regπ πIF (Reg.ax AND &H80) <> 0 THEN Info = (Info OR &H1)π' carrier detect present ?πIF (Reg.ax AND &H100) <> 0 THEN Info = (Info OR &H2)π' buffer has data?πIF (Reg.ax AND &H200) <> 0 THEN Info = (Info OR &H4)π' Was buffer overun?πIF (Reg.ax AND &H4000) = 0 THEN Info = (Info OR &H8)π' output buffer data ?πIF (Reg.ax AND &H2000) = 0 THEN Info = (Info OR &H10)π' Is output buffer overrun?πEND SUBππSUB CtrlBreak (Port, Present)πSELECT CASE Portπ    CASE 0π    address = &H3F8π    CASE 1π    address = &H2F8π    CASE 2π    address = &H3E8π    CASE ELSEπ    address = &H2E8πEND SELECTπOld1 = INP(address + 1)πOUT address + 1, 0πOld2 = INP(address + 3)πSetLow = Old2 OR &H40πA# = TIMERπOUT address + 3, SetLowπDelay .5πOUT address + 3, Old2 'Set it back the way it was!πOUT address + 1, Old1πEND SUBππDEFSNG A-ZπSUB Delay (X!) STATICπCheckTime! = TIMERπWHILE TIMER < CheckTime! + X!πWENDπEND SUBππDEFINT A-ZπSUB ErrorMessage (A$, X) STATICπA$ = ""πSELECT CASE Xπ π   CASE 3π      A$ = "Return with out GOSUB."π   CASE 4π   A$ = "Out of Data."π   CASE 5π             A$ = "Illegal Function Call."π   CASE 6π             A$ = "Math Overflow."π   CASE 7π             A$ = "Out of Memory."π   CASE 9π             A$ = "Subscript out of range."π   CASE 11π             A$ = "Division by Zero."π   CASE 14π             A$ = "Out of String Space."π   CASE 16π             A$ = "String Formula Too Complex."π   CASE 19π             A$ = "No RESUME."π   CASE 20π             A$ = "RESUME without error."π   CASE 24π             A$ = "Device TimeOut."π   CASE 25π             A$ = "Device Fault."π   CASE 27π             A$ = "Out of Paper."π   CASE 39π             A$ = "Case Else Expected."π   CASE 40π             A$ = "Variable Required."π   CASE 50π             A$ = "Field OverFlow."π   CASE 51π             A$ = "Internal Error."π   CASE 52π             A$ = "Bad File Name or Number."π   CASE 53π             A$ = "File Not Found."π   CASE 54π             A$ = "Bad File Mode."π   CASE 55π             A$ = "File Already Open."π   CASE 56π             A$ = "Field Statement Active."π   CASE 57π             A$ = "Device I/O Error."π   CASE 58π             A$ = "File Already exists."π   CASE 59π             A$ = "Bad Record Length."π   CASE 61π             A$ = "Disk Full."π   CASE 62π             A$ = "Input past end of file."π   CASE 63π             A$ = "Bad Record Number."π   CASE 64π             A$ = "Bad File Name."π   CASE 67π             A$ = "Too many files."π   CASE 68π             A$ = "Device Unavailable."π   CASE 69π             A$ = "Communications Buffer OverFlow."π   CASE 70π             A$ = "Access Denied."π   CASE 71π             A$ = "Disk or Drive Not Ready."π   CASE 72π             A$ = "Disk Media Error. (Bad Disk!)"π   CASE 75π             A$ = "Path/File access error."π   CASE 76π             A$ = "Path not Found."π   CASE ELSEπ             A$ = "Unknown Error #" + STR$(X)π πEND SELECTπ πEND SUBππSUB FossDeinit (Port, Reg AS RegType)π' Release the FOSSIL device driverπReg.ax = &H500πReg.dx = PortπINTERRUPT &H14, Reg, RegπEND SUBππSUB FossInit (Port, Present, Reg AS RegType)πPresent = -1π π' Initialize the FOSSIL device driverπ'π' dx = Communications port number (0-3)π' ah = &H04    Fossil Function Number - Initialize FOSSIL driverπ'                                       (Raises DTR in the porcess)π πReg.dx = PortπReg.ax = &H400πINTERRUPT &H14, Reg, RegπIF Reg.ax <> &H1954 THENπ   Present = 0 'Fossil Not FoundπEND IFπ πEND SUBππSUB GetChar (Port, Good, InBound$, Present, Reg AS RegType)πCheckPortStatus Port, Info, Reg ' Test for space in OUTPUT bufferπIF NOT Present THENπ             InBound$ = INKEY$π             IF InBound$ > "" THENπ                    Good = -1π             ELSEπ                    Good = 0π             END IFπ             EXIT SUBπEND IFπIF (Info AND &H4) = 0 THENπ       IF (Info AND &H2) = &H2 THENπ             Reg.ax = &H200π             Reg.dx = Portπ             INTERRUPT &H14, Reg, Regπ             InBound$ = CHR$(Reg.ax)π             Good = -1π       ELSEπ             Good = 0' No Characters in input bufferπ             InBound$ = INKEY$π             IF InBound$ > "" THEN Good = -1π       END IFπELSE ' Input buffer over-runπ       Good = 0π       Reg.ax = &HA00π       Reg.dx = Portπ       INTERRUPT &H14, Reg, Regπ       BEEPπEND IFπEND SUBππSUB PrintCon (A$, Reg AS RegType) STATICπIF A$ = "" THEN EXIT SUBπ       Reg.ax = &H600π       Reg.dx = ASC(A$)π       INTERRUPT &H21, Reg, Regπ       IF A$ = CHR$(13) THENπ             Reg.ax = &H600π             Reg.dx = 10π             INTERRUPT &H21, Reg, Regπ       END IFπEND SUBππSUB SendChar (Port, Sent, Present, Outbound$, Reg AS RegType)πA! = TIMERπIF NOT Present THENπ       Sent = 0π       EXIT SUBπEND IFπDOπ       CheckPortStatus Port, Info, Reg ' room in buffer ?π       IF (Reg.ax AND &H80) = 0 THENπ             Sent = -1π             EXIT DOπ       END IFπ    IF (Info AND &H10) = 0 THENπ         Reg.dx = Portπ         Reg.ax = &H100 + ASC(Outbound$)π         INTERRUPT &H14, Reg, Regπ         Sent = -1π       END IFπLOOP WHILE NOT Sent AND TIMER - A! < 2πIF Sent = 0 AND Reg.ax AND &H80 <> 0 THENπ    Sent = 0 ' Output buffer fullπ    Reg.ax = &H900π    Reg.dx = Portπ    INTERRUPT &H14, Reg, RegπEND IFπEND SUBππSUB SetDtr (Port, DtrStatus$, Reg AS RegType)πReg.dx = Port 'Set carrier detect low or highπSELECT CASE UCASE$(DtrStatus$)π    CASE "L"π    Reg.ax = &H600π    CASE "H"π    Reg.ax = &H601π    CASE ELSEπ    Reg.ax = &H600π    BEEPπEND SELECTπINTERRUPT &H14, Reg, RegπEND SUBππSUB SetHandShake (Port, HandShake, Reg AS RegType)πReg.dx = PortπIF HandShake > &HF THENπ    HandShake = &H2π    'Set handshake to RTS/CTS.π    BEEPπEND IFπReg.ax = &HF00 + HandShakeπINTERRUPT &H14, Reg, RegπReg.ax = &H1000πReg.dx = PortπINTERRUPT &H14, Reg, RegπEND SUBππSUB SetPortParams (Port, Baud$, Bits, Stops, Parity$, Reg AS RegType)πReg.dx = PortπReg.ax = 0πSELECT CASE Baud$π    CASE "300"π    Reg.ax = (Reg.ax OR &H40)π    CASE "600"π    Reg.ax = (Reg.ax OR &H60)π    CASE "1200"π    Reg.ax = (Reg.ax OR &H80)π    CASE "2400"π    Reg.ax = (Reg.ax OR &HA0)π    CASE "4800"π    Reg.ax = (Reg.ax OR &HC0)π    CASE "9600"π    Reg.ax = (Reg.ax OR &HE0)π    CASE "19200"π    Reg.ax = (Reg.ax OR &H0)π    CASE "38400"π    Reg.ax = (Reg.ax OR &H20)π    CASE ELSEπ    Reg.ax = (Reg.ax OR &HA0)π    'Default to 2400 baudπEND SELECTπ πSELECT CASE Bitsπ    CASE 5π    Reg.ax = (Reg.ax OR &H0)π    CASE 6π    Reg.ax = (Reg.ax OR &H1)π    CASE 7π    Reg.ax = (Reg.ax OR &H2)π    CASE 8π    Reg.ax = (Reg.ax OR &H3)π    CASE ELSEπ    Reg.ax = (Reg.ax OR &H3)π    'Default to 8 bitsπEND SELECTπ πSELECT CASE Stopsπ    CASE 1π    Reg.ax = (Reg.ax OR &H0)π    CASE 2π    Reg.ax = (Reg.ax OR &H4)π    CASE ELSEπ    Reg.ax = (Reg.ax OR &H0)π    'Default to 1 stop bitπEND SELECTππSELECT CASE UCASE$(Parity$)π    CASE "N"π    Reg.ax = (Reg.ax OR &H0)π    CASE "O"π    Reg.ax = (Reg.ax OR &H8)π    CASE "E"π    Reg.ax = (Reg.ax OR &H18)π    CASE ELSEπ    Reg.ax = (Reg.ax OR &H0)π    ' Default to no parityπEND SELECTπReg.dx = PortπINTERRUPT &H14, Reg, Reg   'Set it up!πEND SUBππBob Perkins                    QB FOSSIL ROUTINES             FidoNet QUIK_BAS Echo          10-24-95 (21:28)       QB, PDS                348  11206    QBFOSSIL.BAS   '       -=-=-=-=-=-   Data for initfossil()   -=-=-=-=-=-=-π '[initialize fossil driver]π 'port% = 0=com1, 1=com2, 2=com3, 3=com4π 'DTR is raisedπ 'returns 0 for successful, -1 for failureπ 'π '       -=-=-=-=-=-    Data for inituart()    -=-=-=-=-=-=-π '[initialize uart]π 'port% = 0=com1, 1=com2, 2=com3, 3=com4π 'valid baud rates are 38400, 19200, 9600, 4800, 2400, 1200, 600, 300π 'parity% :   0=none   8=odd   24=evenπ 'stop%   :   0=1bit   4=2bitsπ 'wordlen%:   0=5bits  1=6bits  2=7bits  3=8bitsπ 'returns rs-232 status code bits in ahπ 'bit0=RDA   (input data available in buffer)π 'bit1=OVRN  (data has been lost)π 'bit5=THRE  (room available in output buffer)π 'bit6=TSRE  (output buffer empty)π 'returns modem status bits in alπ 'bit3 = always setπ 'bit7 = carrier detectπ 'π '       -=-=-=-=-=-  Data for deinitfossil()  -=-=-=-=-=-=-π '[deinitialize fossil driver]π 'port% = 0=com1, 1=com2, 2=com3, 3=com4π 'state of DTR is not affected, use setDTR() first to set desired state.π 'nothing returnedπ 'π '       -=-=-=-=-=-     Data for setDTR()     -=-=-=-=-=-=-π '[set state of DTR]π 'port%  = 0=com1, 1=com2, 2=com3, 3=com4π 'state% = 0 to lower,  1 to raiseπ 'nothing returnedπ 'π '       -=-=-=-=-=-    Data for waitreceive   -=-=-=-=-=-=-π '[get character from port with wait]π 'NOTE: Will not return until a character is received!π '      Use check4char%() before calling!π 'port% = 0=com1, 1=com2, 2=com3, 3=com4π 'returns ascii value of character receivedπ 'π '       -=-=-=-=-=-    Data for check4char    -=-=-=-=-=-=-π '[non-destructive read-ahead]π 'Use before waitreceive() to make sure character available.π '"peeks" at character without retrieving from buffer.π 'port% = 0=com1, 1=com2, 2=com3, 3=com4π 'returns 0 for no character, or ascii value of char waiting in bufferπ 'π '       -=-=-=-=-=-     Data for sendchar%    -=-=-=-=-=-=-π '[send character out port]π 'port% = 0=com1, 1=com2, 2=com3, 3=com4π 'returns 0 if successful, -1 if character rejected (buffer full)π 'π '       -=-=-=-=-=-   Data for getdriverinfo  -=-=-=-=-=-=-π '[get information about fossil driver]π 'port% = 0=com1, 1=com2, 2=com3, 3=com4π 'loads structure driverinfo with information about driverπ 'π '       -=-=-=-=-=-    Data for flushbuffer   -=-=-=-=-=-=-π '[flush output buffer]π 'port% = 0=com1, 1=com2, 2=com3, 3=com4π 'flushes buffer, waiting until all characters have been sentπ 'nothing returnedπ 'π '       -=-=-=-=-=-  Data for purgeoutputbuff -=-=-=-=-=-=-π '[purge output buffer]π 'port% = 0=com1, 1=com2, 2=com3, 3=com4π 'clears output buffer destroying any characters waiting to be sent.π 'nothing returnedπ 'π '       -=-=-=-=-=-  Data for purgeinputbuff  -=-=-=-=-=-=-π '[purge input buffer]π 'port% = 0=com1, 1=com2, 2=com3, 3=com4π 'clears input buffer destroying any characters waiting to be read.π 'nothing returnedπ 'π '       -=-=-=-=-=-     Data for sendbreak    -=-=-=-=-=-=-π '[toggle break]π 'port% = 0=com1, 1=com2, 2=com3, 3=com4π 'status:  1 = start sending break,  0 = stop sending breakπ 'nothing returnedπ 'π '       -=-=-=-=-=-       Data for reboot     -=-=-=-=-=-=-π '[fossil reboot]π 'if coldwarm% = 0 then cold boot  (memory check)π 'if coldwarm% = 1 then warm bootπ 'nothing returned (obviously)π 'π '       -=-=-=-=-=-     Data for writeansi    -=-=-=-=-=-=-π '[writes character to screen with ANSI support]π 'nothing returnedπ '       -=-=-=-=-=-  Data for writeansistrng  -=-=-=-=-=-=-π '[writes a string of characters to the screen with ANSI]π 'uses calls to writeansi()π 'nothing returnedπ 'π '       -=-=-=-=-=-    Data for getcurorpos   -=-=-=-=-=-=-π '[get current cursor location]π 'current row returned in row%, column in column%π 'π '       -=-=-=-=-=-    Data for setcurorpos   -=-=-=-=-=-=-π '[set cursor location]π 'specify row% and column%π 'nothing returnedπ 'π 'π TYPE driverinfoπ   structsize AS INTEGER          'size of structureπ   spec AS STRING * 1             'spec fossil conforms toπ   revlevel AS STRING * 1         'rev level of fossilπ   IDoffset AS INTEGER            'id string offsetπ   IDsegment AS INTEGER           'id string segmentπ   inputbuffsize AS INTEGER       'input buffer size in bytesπ   inpbytesleft AS INTEGER        'bytes waiting in bufferπ   outputbuffsize AS INTEGER      'output buffer size in bytesπ   outbytesleft AS INTEGER        'bytes waiting in bufferπ   screenwidth AS STRING * 1      'screen widthπ   screenlength AS STRING * 1     'screen lengthπ   comp2modembaud AS STRING * 1   'computer to modem baud rateπ END TYPEπ DIM SHARED driverinfo AS driverinfo  'structure for getdriverinfo()π 'ππ '$INCLUDE: 'qb.bi'π DIM SHARED regs AS regtypeπ 'π DECLARE FUNCTION initfossil% (port%)π DECLARE SUB deinitfossil (port%)π DECLARE FUNCTION inituart% (port%, baud&, parity%, stopbits%, wordlen%)π DECLARE SUB setDTR (port%, state%)π DECLARE FUNCTION waitreceive% (port%)π DECLARE FUNCTION check4char% (port%)π DECLARE FUNCTION sendchar% (port%, char%)π DECLARE SUB getdriverinfo (port%)π DECLARE SUB flushbuffer (port%)π DECLARE SUB purgeoutputbuff (port%)π DECLARE SUB purgeinputbuff (port%)π DECLARE SUB sendbreak (port%, status%)π DECLARE SUB reboot (coldwarm%)π DECLARE SUB writeansi (char%)π DECLARE SUB writeansistrng (ansistring$)π DECLARE SUB setcursorpos (row%, column%)π DECLARE SUB getcursorpos (row%, column%)π DECLARE FUNCTION getblock% (buffer$, port%)π DECLARE FUNCTION writeblock% (port%)π 'π crlf$ = CHR$(13) + CHR$(10)π ctrlx$ = CHR$(24)π port% = 1        'com2:π '......................... Initialize FOSSIL .........................π IF initfossil%(port%) THEN PRINT "Fossil driver not loaded!": ENDπ '.......................... Initialize UART ...........................π 'com2:, 9600 baud, no parity, 1 stop bit, 8 data bitsπ baud& = 9600: parity% = 0: stopbits% = 0: wordlen% = 3π status% = inituart%(port%, baud&, parity%, stopbits%, wordlen%)π '.................. Display Fossil driver ID string ...................π getdriverinfo (port%)π DEF SEG = driverinfo.IDsegment      'get fossil ID stringπ CLS : x% = 0: PRINT "Fossil ID string = ";π DOπ   a% = PEEK(driverinfo.IDoffset% + x%)π   writeansi a%π   x% = x% + 1π LOOP UNTIL a% = 0π DEF SEGπ writeansistrng crlf$ + crlf$ + "To exit press CTRL-X" + crlf$π '......................... Main Program Loop...........................π 'simple modem communications program...π DOπ  a$ = INKEY$π  IF LEN(a$) THENπ     DOπ       test% = sendchar%(port%, ASC(a$))    'send until acceptedπ     LOOP WHILE test%π  END IFπ  IF check4char%(port%) THENπ    char% = waitreceive(port%)π    writeansi char%π  END IFπ LOOP UNTIL a$ = ctrlx$π '............................. Program End ............................π 'π setDTR port%, 0       'lower DTRπ writeansistrng crlf$ + "FOSSIL deinitializing.  Program End."π deinitfossil port%    'release fossilπ ENDππ FUNCTION check4char% (port%)π 'non-destructive read-ahead to peek and see if char waiting..π regs.ax = &HC00π regs.dx = port%π interrupt &H14, regs, regsπ IF regs.ax = &HFFFF THENπ   check4char% = 0π ELSEπ   check4char% = regs.ax AND &HFFπ END IFπ END FUNCTIONππ SUB deinitfossil (port%)π 'DTR is NOT affectedπ regs.ax = &H500π regs.dx = port%π interrupt &H14, regs, regsπ END SUBππ SUB flushbuffer (port%)π 'flush buffer waiting until all output is doneπ regs.ax = &H800π regs.dx = port%π interrupt &H14, regs, regsπ END SUBππ FUNCTION getblock% (buffer$, port%)π   DIM regsx AS regtypexπ   regsx.ax = &H1800π   regsx.cx = LEN(buffer$)π   regsx.dx = port%π   regsx.es = VARSEG(buffer$)π   regsx.di = SADD(buffer$)π   interruptx &H14, regsx, regsxπ   getblock% = regs.axπ END FUNCTIONππ SUB getcursorpos (row%, column%)π   regs.ax = &H1200π   interrupt &H14, regs, regsπ   row% = (regs.dx AND &HFF00) \ 256π   column% = regs.dx AND &HFFπ END SUBππ SUB getdriverinfo (port%)π DIM regsx AS regtypexπ regsx.ax = &H1B00π regsx.dx = port%π regsx.cx = LEN(driverinfo)π regsx.es = VARSEG(driverinfo)π regsx.di = VARPTR(driverinfo)π interruptx &H14, regsx, regsxπ 'π ' AX = number of characters transferredπ ' CX = 3058h ("0X") (X00 FOSSIL only)π ' DX = 2030h (" 0") (X00 FOSSIL only)π 'π 'structure driveinfo filled with data from call..π END SUBππ FUNCTION initfossil% (port%)π regs.ax = &H400π regs.dx = port%π interrupt &H14, regs, regsπ IF regs.ax = &H1954 THEN initfossil% = 0 ELSE initfossil% = -1π END FUNCTIONππ FUNCTION inituart% (port%, baud&, parity%, stopbits%, wordlen%)π 'regs.ah = 0, regs.al = parametersπ 'regs.dx = port to init 0=com1, 1=com2, etc.. (255 for local testing)π 'parity = bits 4-3,  stopbits = bit 2,  wordlength = bits 1-0π   SELECT CASE baud&π     CASE 38400: baudrate% = 32  '001  bits 7-6-5π     CASE 19200: baudrate% = 0   '000π     CASE 9600: baudrate% = 224  '111π     CASE 4800: baudrate% = 192  '110π     CASE 2400: baudrate% = 160  '101π     CASE 1200: baudrate% = 128  '100π     CASE 600: baudrate% = 96    '011π     CASE 300: baudrate% = 64    '010π   END SELECTπ regs.ax = baudrate% + parity% + stopbits% + wordlen%π regs.dx = port%π interrupt &H14, regs, regsππ 'Return: AH = RS-232 status code bitsπ '            0: RDA - input data is available in bufferπ '            1: OVRN - data has been lostπ '            5: THRE - room is available in output bufferπ '            6: TSRE - output buffer emptyπ '        AL = modem status bitsπ '            3 : always 1π '            7: DCD - carrier detectππ inituart% = regs.axπ END FUNCTIONππ SUB purgeinputbuff (port%)π regs.ax = &HA00π regs.dx = port%π interrupt &H14, regs, regsπ END SUBππ SUB purgeoutputbuff (port%)π regs.ax = &H900π regs.dx = port%π interrupt &H14, regs, regsπ END SUBππ SUB reboot (coldwarm%)π 'if coldwarm% = 0 then cold boot, 1 then warm boot.π regs.ax = &H1700 + coldwarm%π interrupt &H14, regs, regsπ END SUBππ SUB sendbreak (port%, status%)π 'status = 1 send break, status = 0 stop sending breakπ regs.ax = &H1A00 + status%π regs.dx = port%π interrupt &H14, regs, regsπ END SUBππ FUNCTION sendchar% (port%, char%)π 'returns 0 if char accepted, -1 if not..π regs.ax = &HB00 + char%π regs.dx = port%π interrupt &H14, regs, regsπ IF regs.ax = 0 THEN sendchar% = -1 ELSE sendchar% = 0π END FUNCTIONππ SUB setcursorpos (row%, column%)π   regs.ax = &H1100π   regs.dx = row% * 256 + column%π   interrupt &H14, regs, regsπ END SUBππ SUB setDTR (port%, state%)π regs.ax = &H600 + state% 'state% = 0 for lower or 1 for raiseπ regs.dx = port%π interrupt &H14, regs, regsπ END SUBππ FUNCTION waitreceive% (port%)π regs.ax = &H200π regs.dx = port%π interrupt &H14, regs, regsπ waitreceive% = regs.ax  'ah will be 0 so no need to AND with FFhπ END FUNCTIONππ SUB writeansi (char%)π   regs.ax = &H1300 + char%π   interrupt &H14, regs, regsπ END SUBππ SUB writeansistrng (ansistring$)π   'calls writeansi() for each character in stringπ   FOR x% = 1 TO LEN(ansistring$)π     writeansi ASC((MID$(ansistring$, x%, 1)))π   NEXT x%π END SUBππUnknown Author(s)              GRAPHICAL MOUSE GRID           FidoNet QUIK_BAS Echo          Unknown Date           QB, PDS, VB            352  12088    MOUSGRID.BAS'π'                            G r i d  .  B a sπ'           VBDOS/PDS/QB Code to Demonstrate Code Interactionπ'                          with Mouse Clicksπ'  π'               Program Quits on press of the <ESC> Key.ππ' NOTE: Make sure to Load in the Default Quick Library using "/L"π' when running this code...ππ' |========================================================================|π' | Note:  This  code  was  actually written  under VBDOS. While _all_ of  |π' | the  Interrupt Calls  would have worked under QB with just INTERRUPT,  |π' | _some_ of the Calls wouldn't have worked in VBDOS (or PDS Far Strings) |π' | without INTERRUPTX.  I Figured just  sticking to one type of Interrupt |π' | Call (IntX),  would  be easiest,  least confusing,  and most portable. |π' |========================================================================|ππ' Define the Constants used for Button Clicks..π  CONST Raised% = 0: CONST Depressed% = NOT Raised%ππ' =============================| Functions |==============================π' Draws a ScreenFull of Square Gridsπ  DECLARE FUNCTION DrawGrid% ()ππ' Runs all the Routines in this Moduleπ  DECLARE FUNCTION RunGridDemo% ()ππ' Checks for Existance (sp) of Mouse Driverπ  DECLARE FUNCTION HaveMouse% ()ππ' ============================| SubRoutines |=============================π' Generic Mouse Driverπ  DECLARE SUB Mouse (M0, M1, M2, M3)π'π' Displays Mouse Cursorπ  DECLARE SUB MouseShow ()π'π' Hides Mouse Cursorπ  DECLARE SUB MouseHide ()ππ' Draws a Graphical Mouse Cursorπ  DECLARE SUB MouseCursor ()ππ' Polls for KeyPress or MouseClickπ  DECLARE SUB GetEvents ()ππ' Draws Individual Grid Elementsπ  DECLARE SUB DrawButton (XPos%, YPos%, State)ππ' Draws Depressed/Released Buttonπ  DECLARE SUB ClickButton (M2, M3, M1)ππ' ============================| Variables |=============================π' Define the type needed for INTERUPTX call..π  TYPE RegTypeXπ  ax    AS INTEGERπ  bx    AS INTEGERπ  cx    AS INTEGERπ  Dx    AS INTEGERπ  bp    AS INTEGERπ  si    AS INTEGERπ  di    AS INTEGERπ  flags AS INTEGERπ  ds    AS INTEGERπ  es    AS INTEGERπ  END TYPEππ' DIM the Interrupt TYPE ..π  DIM SHARED Regs AS RegTypeXπ π' Define the Grid Data as Sharedπ  DIM SHARED GridRows%, GridCols%, GridLength%, GridHeight%π  DIM SHARED RowOffset%, GridEndX%, ColOffset%, GridEndY%ππ' Define Grid Error Handler Return Variable as Sharedπ  DIM SHARED Abort%π  π' ===================| Module Level Demo Code |=====================π  ' Set Up the Size of The Grid, before We Start the Routine..π  ' Start with your Original Configuration - an 8*8 box,π  ' in a 48*48 Grid ...π    GridRows% = 48: GridCols% = 48π    GridLength% = 8: GridHeight% = 8ππ  ' Call the Main Routineπ    Success% = RunGridDemo%ππ ' Or UNREM the lines below to try - looks like a SpreadSheet, andπ ' even though it runs off the Screen, you can still depressπ ' the buttons ...π   ' GridRows% = 6: GridCols% = 6π   ' GridLength% = 135: GridHeight% = 30π   ' Success% = RunGridDemo%ππ    SCREEN 0, , 0, 0: SYSTEMππ' =================| Module Level Error Handler |==================πErrorHandler:π   SCREEN 0, , 0, 0   ' Back to Text Mode ...ππ   SELECT CASE ERRπ   CASE 5           ' "Illegal Function Call" - Bad Screen Mode ?π    ErrMsg$ = "You Must have a VGA to run this program"π   CASE 6        ' OverFlow - Probable Too Large a Grid Square for Mem.π    ErrMsg$ = "Your Individual Grid Size is too Large for Memory."π   CASE 32766    ' Grid won't fit On Screenπ    ErrMsg$ = "Grid Dimension(s) will not fit On Screen."π   CASE 32767    ' No Mouse Presentπ    ErrMsg$ = "There is no Mouse Present to run this Demo."π   CASE ELSEπ     ErrMsg$ = "Unknown Error."π   END SELECTππ   L% = LEN(ErrMsg$)           ' Get Length of Error Messageπ   LOCATE 15, (80 - L%) \ 2: PRINT ErrMsg$  ' Center the Messageπ   LOCATE 17, 31: PRINT "Aborting Program."ππ   Abort% = -1                 ' Set ABORT Flagπ   RESUME NEXT                 ' Return to Calling Routineπππ' ========================| Mouse Cursor Data |============================π  DATA &HF3FF,&HE1FF,&HE1FF,&HE07F,&HE00F,&HE001,&HE000,&H8000π  DATA &H0,&H0,&H0,&H0,&H0,&H0,&H8001,&HC003π  DATA &H0,&HC00,&HC00,&HC00,&HD80,&HDB0,&HDB6,&HDB6π  DATA &H6DB6,&H6FFE,&H6FFE,&H7FFE,&H7FFE,&H7FFE,&H3FFC,&H0π  DATA 5 ,0ππSUB ClickButton (M2, M3, M1)π   ' Computes Button Top and Left withing Grid, thenπ   ' Automatically Calls the DrawBox Routine with the correctπ   ' (Raised or Depressed) Parameterπ   ' M2 - X Location of Mouse Click, returned from Mouse Callπ   ' M3 - Y Location of Mouse Click, returned from Mouse Callπ   ' M1 - Whether Mouse Button is Depressed : returned from Mouse Callππ    XOffsetIntoGrid% = M2 - RowOffset% - 1 ' Incremental Distance fromπ    YOffsetIntoGrid% = M3 - ColOffset% - 1 ' the Top/Left Edges of Gridππ    XGrid% = XOffsetIntoGrid% \ GridLength%  ' Compute Which Individualπ    YGrid% = YOffsetIntoGrid% \ GridHeight%   ' Grid Unit was Clickedπ    π    XLocation% = (XGrid% * GridLength%) + RowOffset%  ' Left Edge of Buttonπ    YLocation% = (YGrid% * GridHeight%) + ColOffset%  ' Top Edge of Buttonππ    MouseHide                               ' Hide Mouseπ    DrawButton XLocation%, YLocation%, M1   ' Draw the Buttonπ    MouseShow                               ' Show the MouseππEND SUBππSUB DrawButton (XPos%, YPos%, State)π    ' Draws an Individual Button in the Grid,π    ' in either the Raised, or Derpressed, Conditionπ    ' Parameters: XPos% : Pixel Pos of Left Edge of Boxπ    '             YPos% : Pixel Pos of Top Edge of Boxπ    '             State : Either Raised, or Depressedππ    IF State THEN           ' Just Switch the "Foreground"π      Fg% = 8: Bg% = 15     ' and "BackGround" Colors (shading)π    ELSE                    ' to simulate either a Raised orπ      Fg% = 15: Bg% = 8     ' a Depressed Stateπ    END IFππ   ' Now Draw the Individual Buttonπ    LINE (XPos%, YPos%)-(XPos% + GridLength% - 1, YPos% + GridHeight% - 1), 7, BFπ    LINE (XPos%, YPos% + GridHeight% - 1)-(XPos%, YPos%), Fg%π    LINE -(XPos% + GridLength% - 1, YPos%), Fg%π    LINE -(XPos% + GridLength% - 1, YPos% + GridHeight% - 1), Bg%π    LINE -(XPos% + 1, YPos% + GridHeight% - 1), Bg%ππEND SUBππFUNCTION DrawGrid%π  ' Draws a Screen Full of Grids dependent on Variables Assignedπ  ' at the Module Level.π  '          -=  Shared variables used are as Follows: =-π  ' GridRows% : Number of Grids along the Horizontal Planeπ  ' GridCols% : Number of Grids along Vertical Planeπ  ' GridLength% : Length of Grid in Current Screen Sizeπ  ' GridHeight: Height of Individual Grid in Current Screen Size..π  π  ' Compute where to Center the Grid on the Horizontal ...π    RowBytes% = GridRows% * GridLength%     ' Pixels in each Rowπ    RowOffset% = (640 - RowBytes%) \ 2  ' Left Edge of Gridπ    GridEndX% = RowOffset% + (GridRows% * GridLength%)ππ  ' Compute Where to Center the Grid on the Vertical ...π    ColBytes% = GridCols% * GridHeight%      ' Pixels in each Columnπ    ColOffset% = (480 - ColBytes%) \ 2  ' Top Edge of Gridπ    GridEndY% = ColOffset% + (GridCols% * GridHeight%)ππ  ' Check to see if Grid will _reasonably_ fit OnScreen..π  ' (Don't want an entire Grid off screem , but Clipping is OK..π    ON ERROR GOTO ErrorHandler:π    IF RowOffset% < -GridLength% OR ColOffset% < -GridHeight% THENπ      ERROR 32766π      EXIT FUNCTIONπ    END IFπ     IF Abort% THEN DrawGrid% = 0: EXIT FUNCTIONππ  ' Draw a Simple BackDrop for Our Grids ...π    LINE (RowOffset% - (GridLength% \ 2), ColOffset% - (GridHeight% \ 2))-(GridEndX% + (GridLength% \ 2), GridEndY% + (GridHeight% \ 2)), 7, BFπ  π  ' And Run a Loop, Drawing the Boxes OnScreenπ    FOR YAxis% = 0 TO GridCols% - 1π      FOR XAxis% = 0 TO GridRows% - 1π        XDatum% = RowOffset% + (XAxis% * GridLength%)π        YDatum% = ColOffset% + (YAxis% * GridHeight%)π        DrawButton XDatum%, YDatum%, Raised%π      NEXT XAxis%π    NEXT YAxis%ππEND FUNCTIONππSUB GetEventsπ   ' Loops constantly, polling for either a Mouse Click,π   ' or Aborts on an <ESC> KeyPress.ππ  DOπ   ' Check for Mouse Click Eventπ     M0 = 3: M1 = 0: M2 = 0: M3 = 0          ' Initialize Ax  Reg only ...π     Mouse M0, M1, M2, M3     ' Call Mouse Interruptππ   ' We don't care which button was Clicked, so just see ifπ   ' the Bx Register (the Value returned in the "M1" Variable)π   ' has a value other than "0".π    IF M1 THEN          ' Yep, Button was Clicked - is it in our Grid ?π      IF M2 >= RowOffset% AND M2 <= GridEndX% THEN    ' In Horz Grid ?π        IF M3 >= ColOffset% AND M3 <= GridEndY% THEN  ' In Vert Gridπ          X1 = M2: Y1 = M3π          ClickButton X1, Y1, M1               ' Yep - Hilight Buttonπ           DOπ             M0 = 3: M1 = 0: M2 = 0: M3 = 0    ' Loop until Releasedπ             Mouse M0, M1, M2, M3              ' Call Mouse Interruptπ           LOOP UNTIL M1 = 0π           ClickButton X1, Y1, M1π        END IFπ       END IFπ    END IFπ  π  ' And Check for an <ESC> Key KeyPress...π    a$ = INKEY$π    IF a$ = CHR$(27) THEN Quit% = -1ππ  LOOP UNTIL Quit%ππ  πEND SUBππFUNCTION HaveMouse%π ' Checks to see if Mouse is Installedππ  DEF SEG = 0π   MouseSegment& = 256& * PEEK(207) + PEEK(206)π   MouseOffset& = 256& * PEEK(205) + PEEK(204)ππ  DEF SEG = MouseSegment&π   IF (MouseSegment& = 0 AND MouseOffset& = 0) OR PEEK(MouseOffset&) = 207 THENπ    HaveMouse% = 0π   ELSEπ    HaveMouse% = 1π   END IFπ  DEF SEGππEND FUNCTIONππSUB Mouse (M0, M1, M2, M3)π  ' Calls interrupt &H33 to invoke Mouse Functions in the MS Mouse Driver.ππ  Regs.ax = M0: Regs.bx = M1: Regs.cx = M2: Regs.Dx = M3π  CALL INTERRUPT(&H33, Regs, Regs)π  M0 = Regs.ax: M1 = Regs.bx: M2 = Regs.cx: M3 = Regs.DxππEND SUBππSUB MouseCursorπ  ' Reads in DATA for Mouse Cursor, Draws Mouse Cursorπ  ' Using INT&H33 / 9ππ  ' Read in Graphical Mouse Cursor Dataπ    FOR i% = 1 TO 32                     ' Run a Loop thru the DATAπ      READ Wrd%                          ' Read in Integer Dataπ      MMsk$ = MMsk$ + MKI$(Wrd%)         ' Translate to BYTEsπ    NEXT i%π    READ Hotx, Hoty                      ' Cursor HotSpotππ  ' Now For the Interrupt call ..π    Regs.ax = 9: Regs.bx = Hotx: Regs.cx = Hotyπ    Regs.Dx = SADD(MMsk$)   ' Use with all Basics ..ππ  ' Next Line not neeeded for QB, (Optional for PDS ??)π  ' But using it gives Far String Support.π    Regs.es = VARSEG(MMsk$)  ' Need InterruptX for this One ..ππ    CALL INTERRUPTX(&H33, Regs, Regs)ππEND SUBππSUB MouseHideπ    ' Hides Mouse cursorπ      Mouse 2, 0, 0, 0πEND SUBππSUB MouseShowπ  ' Shows mouse Cursorπ    Mouse 1, 0, 0, 0πEND SUBππFUNCTION RunGridDemo%π  ' Sets Up Program - Returns TRUE if all went rightππ  ' First, Check for VGA ..π    ON ERROR GOTO ErrorHandler:π     SCREEN 12π    ON ERROR GOTO 0π    IF Abort% THEN RunGridDemo% = 0: EXIT FUNCTIONπ  π  ' Blank the Screen while Drawing ..π    OUT &H3C4, 1: Cmr% = INP(&H3C5): OUT &H3C5, Cmr% OR &H20π  π  ' We've Got VGA, Now Draw the Grids ..π    Success% = DrawGrid%π  π  ' Turn the Screen back On ..π    OUT &H3C4, 1: Cmr% = INP(&H3C5): OUT &H3C5, Cmr% AND &HDFππ  ' Check for Error AFTER We turn the Screen Back on...π    IF Abort% THEN RunGridDemo% = 0: EXIT FUNCTIONππ  ' Check for Mouse ...π    IF HaveMouse = 1 THEN           ' The Rodent is IN ..π      Mouse 0, 0, 0, 0              ' Initialize Mouseπ      MouseCursor                   ' Draw "Pointing Hand"π      MouseShow                     ' Show Mouse Cursorπ    ELSEπ      ON ERROR GOTO ErrorHandler:π        ERROR 32767                 ' Invoke own Errorπ      ON ERROR GOTO 0π      RunGridDemo% = 0: EXIT FUNCTIONπ  END IFππ  ' Now Just hang around, waiting for Something to Happen ..π    GetEventsππ  ' If we Made it to here, everything's OK ...π    RunGridDemo% = -1π    MouseHideππEND FUNCTIONππChad Beck                      MOUSE PAINT                    FidoNet QUIK_BAS Echo          Unknown Date           QB, PDS                70   2183     MPAINT.BAS    DEFINT A-Zπ  '$INCLUDE: 'qb.bi'π  DIM SHARED Registers AS RegTypeππ  CONST GridSize = 8, BoxSize = GridSize - 2π  CONST GridColr = 8π  DrawingColr = 4                       'Selected drawing color #π  Colr = DrawingColr                    'Toggles black & DrawingColrππ'Initialize the mouseπ  Registers.AX = 0π  CALL Interrupt(&H33, Registers, Registers)ππ'Drawing gridπ  SCREEN 12π  FOR X = 110 TO 500 STEP GridSizeπ    LINE (X, 2)-(X, 386), GridColrπ    LINE (110, X - 108)-(494, X - 108), GridColrπ  NEXTππ'Set horizontal boundariesπ  Registers.AX = 7π  Registers.CX = 0                      'Registers.CX = 112π  Registers.DX = 620                    'Registers.DX = 495π  CALL Interrupt(&H33, Registers, Registers)ππ'Set vertical boundariesπ  Registers.AX = 8π  Registers.CX = 1π  Registers.DX = 452                    'Registers.DX = 382π  CALL Interrupt(&H33, Registers, Registers)ππ  DOπ  'Show the mouse cursorπ    Registers.AX = 1π    CALL Interrupt(&H33, Registers, Registers)πTop:π    DOπ    'Get mouse location and status:π      'If Registers.BX=1 then left button is pushedπ      'If Registers.BX=2 then right button is pushedπ      'If Registers.BX=3 then both buttons have been pushedππ      Registers.AX = 3π      CALL Interrupt(&H33, Registers, Registers)ππ      OldButtons = Buttons              'Save previous button stateπ      Buttons = Registers.BXπ    LOOP UNTIL Buttons = 1              'Wait for left buttonππ    OldX = Xo: OldY = Yo                'Save previous coordinatesπ    X = Registers.CXπ    Y = Registers.DXππ    Xo = (X \ GridSize) * GridSize - 1  'Adjust for odd grid placementπ    Yo = (Y \ GridSize) * GridSize + 3ππ  'If the cursor or buttons haven't changed then do nothingπ    IF (OldX - Xo) + (OldY - Yo) + (OldButtons - Buttons) = 0 THENπ      GOTO Top:π    END IFπ    IF POINT(Xo, Yo) = Colr THEN Colr = Colr XOR DrawingColrππ  'Painting routineπ    Registers.AX = 2                    'Hide the mouse cursorπ    CALL Interrupt(&H33, Registers, Registers)π    LINE (Xo, Yo)-STEP(BoxSize, BoxSize), Colr, BFπ    PSET ((Xo \ GridSize), (Yo \ GridSize)), Colrππ  LOOPπGlen Blankenship               MOUSE FUNCTIONS FOR QBASIC     comp.lang.basic.misc           Year of 1995           QB, QBasic, PDS        232  8114     MOUSE4QB.BAS'There are two core functions, InitMouse and CallMouse.  InitMouseπ'establishes that a mouse driver is present and active and initializes theπ'mouse to its default state.  CallMouse performs the actual function calls.ππ'In addition, I've included subroutines for several standard mouse functionπ'calls.  The only one that's at all complex is the cursor-setting routine.π'Most of the others are simple "wrappers" that pass the caller's parametersπ'on to CallMouse, after setting any unused parameters to zero.ππ'It's easy enough to builds wrappers for any mouse functions I haven'tπ'included - just look at any list of Int 33h mouse calls, and place theπ'register parameters in the correspondingly-named CallMouse parameters.ππ'Here's the program:π'------------------------------------------------------------π'MOUS4QB.BAS - Mouse functions for QBasicπ'By Glen Blankenship, 1995π'This code is hereby dedicated to the public domain.ππDEFINT A-Zππ'The two core functions:πDECLARE SUB CallMouse (regAX%, regBX%, regCX%, regDX%)πDECLARE FUNCTION InitMouse% ()π                  π'Wrappers for assorted mouse-driver function calls:πDECLARE SUB MouseHardReset ()πDECLARE SUB MouseShow ()πDECLARE SUB MouseHide ()πDECLARE SUB MouseGetStatus (LButton%, RButton%, WhereX%, WhereY%)πDECLARE SUB MousePut (XCoord%, YCoord%)πDECLARE SUB MouseHorizLimits (Left%, Right%)πDECLARE SUB MouseVertLimits (Upper%, Lower%)πDECLARE SUB MouseSetGraphCursor ()ππCONST FALSE = 0πCONST TRUE = NOT FALSEππ'=-=-=-=-=-=-= Test Program  =-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-πCONST LimitLeft = 100πCONST LimitRight = 400πCONST LimitTop = 50πCONST LimitBottom = 200ππCLSπSCREEN 9πIF InitMouse THENπ   MouseHorizLimits LimitLeft, LimitRightπ   MouseVertLimits LimitTop, LimitBottomπ  π   'Draw box to show Mouse Motion Limitsπ   LINE (LimitRight, LimitTop)-(LimitLeft, LimitBottom), 3, BFπ  π   'Create a hand-shaped mouse cursorπ   RESTORE Handπ   MouseSetGraphCursorπ  π   'Place the cursor in the middle of the boxπ   BoxCenterX = LimitLeft + ((LimitRight - LimitLeft) \ 2)π   BoxCenterY = LimitTop + ((LimitBottom - LimitTop) \ 2)π   MousePut BoxCenterX, BoxCenterYππ   LOCATE 1, 1π   PRINT "Press either mouse button to quit"π  π   MouseShow                     'Make the cursor visibleπ  π   DOπ      MouseGetStatus LeftButton, RightButton, XCoord, YCoordπ     π      LOCATE 2, 1π      PRINT "X Coordinate:"; XCoordπ      PRINT "Y Coordinate:"; YCoord       'Print Cursor Locationπ   LOOP UNTIL LeftButton OR RightButton   'Loop until either button pressedπ  π   MouseHide                     'Hide the cursorπ   MouseHardReset                'Reset mouse to default stateππELSE                             '(If InitMouse returned 0)π  PRINT "No mouse active";π  SLEEP 1πEND IFπ  πSCREEN 0: WIDTH 80: CLS          'Reset to text modeπSYSTEM                           'Exit to DOSπππHand:          'Data for graphics cursor, used by MouseSetGraphCursorππ'First, the Hot Spot cordinates:πDATA  4        :  'X coordinateπDATA  0        :  'Y coordinateππ'Next, the two cursor masks.  The data is shown here as hexadecimalπ'numbers.  Each hex digit corresponds to 4 bits in the mask.  Theπ'bits are shown graphically in the comment lines.ππ'Screen mask - Clear bits black out the corresponding pixel:πDATA  &HF3FF   : ';X,X,X,X;_,_,X,X;X,X,X,X;X,X,X,X;πDATA  &HE1FF   : ';X,X,X,_;_,_,_,X;X,X,X,X;X,X,X,X;πDATA  &HE1FF   : ';X,X,X,_;_,_,_,X;X,X,X,X;X,X,X,X;πDATA  &HE1FF   : ';X,X,X,_;_,_,_,X;X,X,X,X;X,X,X,X;πDATA  &HE049   : ';X,X,X,_;_,_,_,_;_,X,_,_;X,_,_,X;πDATA  &HE000   : ';X,X,X,_;_,_,_,_;_,_,_,_;_,_,_,_;πDATA  &H8000   : ';X,_,_,_;_,_,_,_;_,_,_,_;_,_,_,_;πDATA  &H0000   : ';_,_,_,_;_,_,_,_;_,_,_,_;_,_,_,_;πDATA  &H0000   : ';_,_,_,_;_,_,_,_;_,_,_,_;_,_,_,_;πDATA  &H0000   : ';_,_,_,_;_,_,_,_;_,_,_,_;_,_,_,_;πDATA  &H0000   : ';_,_,_,_;_,_,_,_;_,_,_,_;_,_,_,_;πDATA  &H8000   : ';X,_,_,_;_,_,_,_;_,_,_,_;_,_,_,_;πDATA  &HC001   : ';X,X,_,_;_,_,_,_;_,_,_,_;_,_,_,X;πDATA  &HE001   : ';X,X,X,_;_,_,_,_;_,_,_,_;_,_,_,X;πDATA  &HE001   : ';X,X,X,_;_,_,_,_;_,_,_,_;_,_,_,X;πDATA  &HE001   : ';X,X,X,_;_,_,_,_;_,_,_,_;_,_,_,X;ππ'Cursor Mask - Set bits invert the color of the corresponding pixel:πDATA  &H0000   : ';_,_,_,_;_,_,_,_;_,_,_,_;_,_,_,_;πDATA  &H0C00   : ';_,_,_,_;X,X,_,_;_,_,_,_;_,_,_,_;πDATA  &H0C00   : ';_,_,_,_;X,X,_,_;_,_,_,_;_,_,_,_;πDATA  &H0C00   : ';_,_,_,_;X,X,_,_;_,_,_,_;_,_,_,_;πDATA  &H0C00   : ';_,_,_,_;X,X,_,_;_,_,_,_;_,_,_,_;πDATA  &H0DB6   : ';_,_,_,_;X,X,_,X;X,_,X,X;_,X,X,_;πDATA  &H0DB6   : ';_,_,_,_;X,X,_,X;X,_,X,X;_,X,X,_;πDATA  &H6DB6   : ';_,X,X,_;X,X,_,X;X,_,X,X;_,X,X,_;πDATA  &H6FFE   : ';_,X,X,_;X,X,X,X;X,X,X,X;X,X,X,_;πDATA  &H6FFE   : ';_,X,X,_;X,X,X,X;X,X,X,X;X,X,X,_;πDATA  &H7FFE   : ';_,X,X,X;X,X,X,X;X,X,X,X;X,X,X,_;πDATA  &H3FFE   : ';_,_,X,X;X,X,X,X;X,X,X,X;X,X,X,_;πDATA  &H1FFC   : ';_,_,_,X;X,X,X,X;X,X,X,X;X,X,_,_;πDATA  &H0FFC   : ';_,_,_,_;X,X,X,X;X,X,X,X;X,X,_,_;πDATA  &H0FFC   : ';_,_,_,_;X,X,X,X;X,X,X,X;X,X,_,_;πDATA  &H0000   : ';_,_,_,_;_,_,_,_;_,_,_,_;_,_,_,_;ππ'End Test Program =-=-=-=-=-=-=-=-=-==-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=ππ'--------------END MOUS4QB.BAS------------------------------------ππSUB CallMouse (regAX, regBX, regCX, regDX)π   SHARED Mseg, Mofs, MousePresent  'shared w/InitMouseπ  π   IF MousePresent THENπ      DEF SEG = Msegπ      CALL ABSOLUTE(regAX, regBX, regCX, regDX, Mofs)π      DEF SEGπ   END IFπEND SUBππFUNCTION InitMouse STATICπ   SHARED Mseg, Mofs, MousePresent     'Shared  w/CallMouseππ   CONST IRET = &HCF          'OpCode of IRET instructionπ   CONST MVector = &H33 * 4   'Mouse interrupt vector address  - Int 33hππ   MousePresent = FALSE       'Assume no mouseπ   InitMouse = FALSEππ   DEF SEG = 0                'Get mouse driver interrupt vectorπ   mv0 = PEEK(MVector)π   mv1 = PEEK(MVector + 1)π   mv2 = PEEK(MVector + 2)π   mv3 = PEEK(MVector + 3)ππ   DEF SEGπ   POKE VARPTR(Mofs), mv0π   POKE VARPTR(Mofs) + 1, mv1π   POKE VARPTR(Mseg), mv2π   POKE VARPTR(Mseg) + 1, mv3ππ   'Check to see if driver is installed.π   'First, make sure vector is non-zero:π   IF Mseg OR Mofs THENπ      'Next, make sure byte at interrupt entry is not an IRET:π      DEF SEG = Msegπ      IF PEEK(Mofs) <> IRET THENπ         Mofs = Mofs + 2            'BASIC entry is at int entry + 2π         MousePresent = TRUE        'It's present.  Is it active?π         ax = 0π         CallMouse ax, 0, 0, 0      'Mouse Function 0 - H'ware resetπ         MousePresent = ax          'Set MousePresent and InitMouseπ         InitMouse = MousePresent   '  to returned value.π      END IFπ      DEF SEGπ   END IFπEND FUNCTIONππSUB MouseGetStatus (LButton, RButton, X, Y) STATICπ   CallMouse 3, Buttons, X, Y          'Function 3: Get Mouse Statusπ   LButton = ((Buttons AND 1) = 1)     'Set Buttons to true/falseπ   RButton = ((Buttons AND 2) = 2)πEND SUBππSUB MouseHardReset STATICπ   CallMouse 0, 0, 0, 0                'Function 0:  Reset MouseπEND SUBππSUB MouseHide STATICπ   CallMouse 2, 0, 0, 0                'Function 2:  Hide CursorπEND SUBππSUB MouseHorizLimits (Left, Right) STATICπ   CallMouse 7, 0, Left, Right         'Function 7:  Limit Horizontal MotionπEND SUBππSUB MousePut (XCoord, YCoord) STATICπ   CallMouse 4, 0, XCoord, YCoord      'Function 4 - Set mouse positionπEND SUBππSUB MouseSetGraphCursor STATICπ   '--- NOTE -------------------------------π   'Caller must RESTORE to cursor DATA blockπ   'before calling this routineπ   '----------------------------------------π   READ HotSpotXπ   READ HotSpotYππ   FOR i = 1 TO 32π      READ HexValπ      cursor$ = cursor$ + MKI$(HexVal)π   NEXTππ   'Function 9 - Set Graphics Cursorπ   CallMouse 9, HotSpotX, HotSpotY, SADD(cursor$)πEND SUBππSUB MouseShow STATICπ   CallMouse 1, 0, 0, 0                'Function 1:  Show CursorπEND SUBππSUB MouseVertLimits (Upper, Lower) STATICπ   CallMouse 8, 0, Upper, Lower        'Function 8:  Limit Vertical MotionπEND SUBππKurt Kuzba                     TEXT MOUSE ROUTINES            FidoNet QUIK_BAS Echo          Unknown Date           QB, PDS                114  2963     TXTMOUSE.BAS'Some of these functions/subs might require a little modification becauseπ'they are set for text mode only. Please use these freely!π'***********************************************************************ππ' $INCLUDE: 'qb.bi'πDEFINT A-ZπDECLARE SUB Mouse (m1%, m2%, m3%, m4%)πDECLARE SUB MousePut (xmouse%, ymouse%)πDECLARE SUB MouseHide ()πDECLARE SUB MouseInches (horizontal%, vertical%)πDECLARE FUNCTION MouseInstall% ()πDECLARE SUB MouseLightPen (switch%)πDECLARE SUB MousePressLeft (leftcount%, xmouse%, ymouse%)πDECLARE SUB MousePressRight (rightcount%, xmouse%, ymouse%)πDECLARE SUB MouseRange (x1%, y1%, x2%, y2%)πDECLARE SUB MouseReleaseLeft (leftcount%, xmouse%, ymouse%)πDECLARE SUB MouseReleaseRight (rightcount%, xmouse%, ymouse%)πDECLARE SUB MouseWarp (threshhold%)πDECLARE SUB MouseShow ()πDECLARE SUB MouseSoftCursor (screenmask%, cursormask%)πDECLARE SUB MouseNow (leftbutton%, rightbutton%, xmouse%, ymouse%)ππIF MouseInstall THEN MouseShowππSUB Mouse (m1%, m2%, m3%, m4%)π       DIM InRegs AS RegTypeX, OutRegs AS RegTypeXπ       InRegs.ax = m1%π       InRegs.bx = m2%π       InRegs.cx = m3%π       InRegs.dx = m4%π       INTERRUPTX &H33, InRegs, OutRegsπ       m1% = OutRegs.axπ       m2% = OutRegs.bxπ       m3% = OutRegs.cxπ       m4% = OutRegs.dxπEND SUBππSUB MouseHideπ       Mouse 2, 0, 0, 0πEND SUBππSUB MouseInches (horizontal%, vertical%)π       IF horizontal% > 100 THEN horizontal% = 100π       IF vertical% > 100 THEN vertical% = 100π       h% = horizontal% * 5 \ 2π       v% = vertical% * 8π       Mouse 10, 0, h%, v%πEND SUBππFUNCTION MouseInstall%π       mflag% = 0π       Mouse mflag%, 0, 0, 0π       MouseInstall% = mflag%πEND FUNCTIONππSUB MouseLightPen (switch%)π       IF switch% THENπ             Mouse 13, 0, 0, 0π       ELSEπ             Mouse 14, 0, 0, 0π       END IFπEND SUBππSUB MouseNow (leftbutton%, rightbutton%, xmouse%, ymouse%)π       Mouse 3, m2%, xmouse%, ymouse%π       leftbutton% = ((m2% AND 1) <> 0)π       rightbutton% = ((m2% AND 2) <> 0)πEND SUBππSUB MousePressLeft (leftcount%, xmouse%, ymouse%)π       m1% = 5π       leftcount% = 0π       Mouse m1%, leftcount%, xmouse%, ymouse%πEND SUBππSUB MousePressRight (rightcount%, xmouse%, ymouse%) STATICπ       m1% = 5π       rightcount% = 1π       Mouse m1%, rightcount%, xmouse%, ymouse%πEND SUBππSUB MousePut (xmouse%, ymouse%)π       Mouse 4, 0, xmouse%, ymouse%πEND SUBππSUB MouseRange (x1%, y1%, x2%, y2%)π       Mouse 7, 0, x1%, x2%π       Mouse 8, 0, y1%, y2%πEND SUBππSUB MouseReleaseLeft (leftcount%, xmouse%, ymouse%)π       m1% = 6π       leftcount% = 0π       Mouse m1%, leftcount%, xmouse%, ymouse%πEND SUBππSUB MouseReleaseRight (rightcount%, xmouse%, ymouse%)π       m1% = 6π       rightmouse% = 1π       Mouse m1%, rightcount%, xmouse%, ymouse%πEND SUBππSUB MouseShowπ       Mouse 1, 0, 0, 0πEND SUBππSUB MouseSoftCursor (screenmask%, cursormask%)π       Mouse 10, 0, screenmask%, cursormask%πEND SUBππSUB MouseWarp (threshold%)π       Mouse 19, 0, 0, threshold%πEND SUBππChris Wagner                   MOUSE TESTER                   FidoNet QUIK_BAS Echo          Unknown Date           QB, PDS                119  3172     MOUSTEST.BAS'*** "Mouse Tester" by Chris Wagnerπ'***πREM $INCLUDE: 'QB.BI'  '*** use QBX.BI in PDS7πDECLARE SUB Mouseon ()πDECLARE SUB MouseOff ()πDECLARE SUB MouseSetHor (Min%, Max%)πDECLARE SUB MouseSetVert (Min%, Max%)πDECLARE SUB MouseLocate (Xpos%, Ypos%)πDECLARE SUB MouseStatus (Vert%, Hor%, Mbuttons$)πDECLARE FUNCTION MouseInstalled% ()πDIM SHARED RegX AS RegTypeXππ    CLSπ    LOCATE 2, 20: PRINT "Mouse Tester    By Chris Wagner";π    LOCATE 4, 20π    IF MouseInstalled% THENπ        PRINT "Mouse found and reset."π    ELSEπ        PRINT "Mouse not found."π        ENDπ    END IFπ    LOCATE 14, 30: PRINT "╔═════════════════════╗";π    LOCATE 15, 30: PRINT "║  Press Q to Quit    ║";π    LOCATE 16, 30: PRINT "║   or Click here     ║";π    LOCATE 17, 30: PRINT "╚═════════════════════╝";π    CALL MouseSetHor(1, 80)π    CALL MouseSetVert(1, 25)π    CALL MouseLocate(20, 70)π    CALL Mouseonπ    LOCATE 25, 1: PRINT "X Coord:    Y Coord:    ";π    DOπ        CALL MouseStatus(Vert%, Hor%, Mbuttons$)π        LOCATE 25, 10: PRINT LTRIM$(STR$(Vert%)); "  ";π        LOCATE 25, 26: PRINT LTRIM$(STR$(Hor%)); "  ";π        LOCATE 25, 48: PRINT Mbuttons$;π        A$ = UCASE$(INKEY$)π        IF Mbuttons$ = "L  " OR A$ = "Q" THENπ            IF Vert% >= 14 AND Vert% <= 17 OR A$ = "Q" THENπ                IF Hor% >= 30 AND Hor% <= 52 OR A$ = "Q" THENπ                    MouseOffπ                    CLSπ                    SYSTEMπ                END IFπ            END IFπ        END IFπ    LOOPππ'====[ EOF ]====ππFUNCTION MouseInstalled%π    DEF SEG = 0π    MouseSeg& = 256& * PEEK(207) + PEEK(206)π    MouseOfs& = 256& * PEEK(205) + PEEK(204) + 2π    DEF SEG = MouseSeg&π    IF (MouseSeg& = 0 AND MouseOfs& = 0) OR PEEK(MouseOfs&) = 207 THENπ        MouseInstalled% = 0π        EXIT FUNCTIONπ    ELSEπ        MouseInstalled% = -1π    END IFπ    DEF SEGπ    RegX.ax = 0π    CALL INTERRUPTX(&H33, RegX, RegX)π    IF RegX.ax = -1 THENπ        MouseInstalled% = -1π    ELSEπ        MouseInstalled% = 0π    END IFπEND FUNCTIONππSUB MouseLocate (Xpos%, Ypos%)π    RegX.dx = (Xpos% * 8) - 1π    RegX.cx = (Ypos% * 8) - 1π    RegX.ax = 4π    CALL INTERRUPTX(&H33, RegX, RegX)πEND SUBππSUB MouseOffπ    RegX.ax = 2π    CALL INTERRUPTX(&H33, RegX, RegX)πEND SUBππSUB Mouseonπ    RegX.ax = 1π    CALL INTERRUPTX(&H33, RegX, RegX)πEND SUBππSUB MouseSetHor (Min%, Max%)π    RegX.cx = (Min% * 8) - 1π    RegX.dx = (Max% * 8) - 1π    RegX.ax = 7π    CALL INTERRUPTX(&H33, RegX, RegX)πEND SUBππSUB MouseSetVert (Min%, Max%)π    RegX.cx = (Min% * 8) - 1π    RegX.dx = (Max% * 8) - 1π    RegX.ax = 8π    CALL INTERRUPTX(&H33, RegX, RegX)πEND SUBππSUB MouseStatus (Vert%, Hor%, Mbuttons$)π    RegX.ax = 3π    CALL INTERRUPTX(&H33, RegX, RegX)π    Vert% = (RegX.dx / 8) + 1π    Hor% = (RegX.cx / 8) + 1π    SELECT CASE RegX.bxπ        CASE 0π            Mbuttons$ = "   "π        CASE 1π            Mbuttons$ = "L  "π        CASE 2π            Mbuttons$ = "  R"π        CASE 3π            Mbuttons$ = "L R"π        CASE 4π            Mbuttons$ = " C "π    END SELECTπEND SUBπChristy Gemmell                GET/SET FILES DATE/TIME        GET,SET,FILE,DATE,TIME         07-02-95 (00:00)       PB                     201  8784     FILEDATE.BAS' FILEDATE.BAS  get and set a files date and time stamps.π'π'   Author:     Christy Gemmellπ'   Date:       3/7/1995π'   Compiler:   PowerBASICπ'π    DECLARE FUNCTION GetDateFormat% ()π    DECLARE FUNCTION GetFileDate$ (FileName$)π    DECLARE SUB SetFileDate (FileName$, FileDate$, Fmt%, Done%)ππ    CLS : PRINT : FileName$ = "PB.EXE"π    OldDate$ = GetFileDate$(FileName$)π    IF OldDate$ <> "" THENπ       PRINT FileName$; " is currently dated "; OldDate$π       PRINTπ       NewDate$ = LEFT$(DATE$, 6) + MID$(DATE$, 9, 2) + "  " + TIME$π       PRINT "Setting file to current date and time... ";π       CALL SetFileDate(FileName$, NewDate$, -1, Done%)π       IF Done% THENπ          PRINT "done"π          NewDate$ = GetFileDate$(FileName$)π          PRINTπ          PRINT FileName$; " is now dated "; NewDate$π          PRINTπ          PRINT "Now reverting back to previous setting... ";π          CALL SetFileDate(FileName$, OldDate$, 0, Done%)π          IF Done% THENπ             PRINT "done"π             DateNow$ = GetFileDate$(FileName$)π             PRINTπ             PRINT FileName$; " is now dated "; DateNow$π          ELSEπ             PRINT "failed!"π          END IFπ       ELSEπ          PRINT "failed!"π       END IFπ    END IFπENDππ'   Returns a code indicating the national date format.π'π'   Return values:  1 = MM-DD-YY   (USA)π'                   2 = DD/MM/YY   (Europe)π'                   3 = YY-MM-DD   (Japan)π'π'   Depends on COUNTRY = setting in CONFIG.SYS (default = USA)π'πFUNCTION GetDateFormat%π    B$ = SPACE$(64)                     ' To hold country informationπ    REG 8, STRSEG(B$)                   ' DS = segment of bufferπ    REG 4, STRPTR(B$)                   ' DX = offset of bufferπ    REG 1, &H3800                       ' DOS Service 56π    CALL INTERRUPT &H21                 ' - get country informationπ    GetDateFormat% = ASC(B$)            ' Date format is first byteπEND FUNCTIONππ'   Returns date and time a file was last updated.π'π'   The date and time are returned as a string in one of these formats:π'π'       --123456789012345678--π'π'         MM-DD-YY  HH:MM:SS    (for USA)π'         DD/MM/YY  HH:MM:SS    (for Europe)π'         YY-MM-DD  HH:MM:SS    (for Japan)π'π'   (there are two blank spaces between the date and timeπ'πFUNCTION GetFileDate$ (FileName$)π    Dt$ = ""                            ' Assume failureπ    F$ = FileName$ + CHR$(0)            ' Make filespec ASCIIZπ    REG 8, STRSEG(F$)                   ' DS = segment of filespecπ    REG 4, STRPTR(F$)                   ' DX = offset of filespecπ    REG 1, &H3D00                       ' DOS Service 61π    CALL INTERRUPT &H21                 ' - open file for readingπ    Carry% = REG(0) AND 1               ' Check carry flagπ    IF Carry% = 0 THEN                  ' If no error occurred..π       Handle% = REG(1)                 ' Get handle from AXπ       REG 2, Handle%                   ' Transfer it to BXπ       REG 1, &H5700                    ' DOS Service 87π       CALL INTERRUPT &H21              ' - get file date and timeπ       Carry% = REG(0) AND 1            ' Check carry flagπ       IF Carry% = 0 THEN               ' If no error occurred..π          FlTime% = REG(3)              ' Bit-encoded time from CXπ          FlDate% = REG(4)              ' Bit-encoded date from DXπ          Yr% = FlDate%                 ' Extractπ          SHIFT RIGHT Yr%, 9            '   theπ          Yr% = Yr% + 1980              '     yearπ          FlDate% = FlDate% AND &H1FF   ' Isolate day and monthπ          Mth% = FlDate%                ' Extractπ          SHIFT RIGHT Mth%, 5           '   the monthπ          Day% = FlDate% AND &H1F       ' Extract dayπ          Hrs% = FlTime%                ' Extractπ          SHIFT RIGHT Hrs%, 11          '   hoursπ          FlTime% = FlTime% AND &H7FF   ' Isolate minutes and secondsπ          Mins% = FlTime%               ' Extractπ          SHIFT RIGHT Mins%, 5          '   minutesπ          Sex% = (FlTime% AND &H1F) * 2 ' Extract secondsπ          Y$ = RIGHT$("0" + LTRIM$(RTRIM$(STR$(Yr%))), 2)π          M$ = RIGHT$("0" + LTRIM$(RTRIM$(STR$(Mth%))), 2)π          D$ = RIGHT$("0" + LTRIM$(RTRIM$(STR$(Day%))), 2)π'(Continued to next message)π'(Continued from previous message)π          Fmt% = GetDateFormat%         ' Get national date formatπ          SELECT CASE Fmt%π              CASE 0                    ' USAπ                   Dt$ = M$ + "-" + D$ + "-" + Y$π              CASE 1                    ' Europeπ                   Dt$ = D$ + "/" + M$ + "/" + Y$π              CASE 2                    ' Japanπ                   Dt$ = Y$ + "-" + M$ + "-" + D$π              CASE ELSEπ          END SELECTπ          H$ = RIGHT$("0" + LTRIM$(RTRIM$(STR$(Hrs%))), 2)π          M$ = RIGHT$("0" + LTRIM$(RTRIM$(STR$(Mins%))), 2)π          S$ = RIGHT$("0" + LTRIM$(RTRIM$(STR$(Sex%))), 2)π          Dt$ = Dt$ + "  " + H$ + ":" + M$ + ":" + S$π       END IFπ       REG 2, Handle%                   ' File handle to BXπ       REG 1, &H3E00                    ' DOS Service 62π       CALL INTERRUPT &H21              ' - close the fileπ    END IFπ    GetFileDate$ = Dt$                  ' Return date and time as stringπEND FUNCTIONππ'   Sets the last-access date and time of the specified file.π'π'   Note: FileDate$ must be in one of the following formats:π'π'       --123456789012345678--π'π'         MM-DD-YY  HH:MM:SS    (for USA)π'         DD/MM/YY  HH:MM:SS    (for Europe)π'         YY-MM-DD  HH:MM:SS    (for Japan)π'π'   (there are two blank spaces between the date and timeπ'π'   If Fmt% is TRUE (non-zero) then the procedure uses the dateπ'   format for the country corresponding to the COUNTRY= settingπ'   in the computers CONFIG.SYS file (default = USA)π'π'   If Fmt% is FALSE (zero) then USA format is used.π'πSUB SetFileDate (FileName$, FileDate$, Fmt%, Done%)π    Done% = 0                           ' Assume failureπ    F$ = FileName$ + CHR$(0)            ' Make filespec ASCIIZπ    REG 8, STRSEG(F$)                   ' DS = segment of filespecπ    REG 4, STRPTR(F$)                   ' DX = offset of filespecπ    REG 1, &H3D00                       ' DOS Service 61π    CALL INTERRUPT &H21                 ' - open file for readingπ    Carry% = REG(0) AND 1               ' Check carry flagπ    IF Carry% = 0 THEN                  ' If no error occurred..π       Handle% = REG(1)                 ' Get handle from AXπ       IF Fmt% THENπ          Fmt% = GetDateFormat%         ' Get national date formatπ       END IFπ       SELECT CASE Fmt%π           CASE 0                       ' USAπ                Day% = VAL(MID$(FileDate$, 4, 2))π                Mth% = VAL(LEFT$(FileDate$, 2))π                Yr% = VAL(MID$(FileDate$, 7, 2))π           CASE 1                       ' Europeπ                Mth% = VAL(MID$(FileDate$, 4, 2))π                Day% = VAL(LEFT$(FileDate$, 2))π                Yr% = VAL(MID$(FileDate$, 7, 2))π           CASE 2                       ' Japanπ                Mth% = VAL(MID$(FileDate$, 4, 2))π                Yr% = VAL(LEFT$(FileDate$, 2))π                Day% = VAL(MID$(FileDate$, 7, 2))π           CASE ELSEπ       END SELECTπ       Hrs% = VAL(MID$(FileDate$, 11, 2))π       Mins% = VAL(MID$(FileDate$, 14, 2))π       Sex% = VAL(MID$(FileDate$, 17, 2)) \ 2π       IF Yr% < 80 THEN Yr% = Yr% + 100 ' Remember the 21st Centuryπ       FlDate& = Yr% - 80               ' Juggle dateπ       SHIFT LEFT FlDate&, 9            '   into theπ       SHIFT LEFT Mth%, 5               '     appropriateπ       FlDate& = FlDate& + Mth% + Day%  '       bit-fieldsπ       REG 4, FlDate&                   ' Load result into DXπ       FlTime& = Hrs%                   ' Juggle timeπ       SHIFT LEFT FlTime&, 11           '   into theπ       SHIFT LEFT Mins%, 5              '     appropriateπ       FlTime& = FlTime& + Mins% + Sex% '       bit-fieldsπ       REG 3, FlTime&                   ' Load result into CXπ       REG 2, Handle%                   ' File handle to BXπ'(Continued to next message)π'(Continued from previous message)π       REG 1, &H5701                    ' DOS Service 87π       CALL INTERRUPT &H21              ' - set file date and timeπ       Carry% = REG(0) AND 1            ' Check carry flagπ       IF Carry% = 0 THEN               ' If no error occurred..π          Done% = -1                    '   report successπ       END IFπ       REG 2, Handle%                   ' File handle to BXπ       REG 1, &H3E00                    ' DOS Service 62π       CALL INTERRUPT &H21              ' - close the fileπ    END IFπEND SUBππWalt Mayo                      BSAVE SCREEN CAPTURE TSR       FidoNet QUIK_BAS Echo          Year of 1993           PB                     63   2337     BSVGRAB.BAS '***********************************************************************π'* PopUp .BSV Screen Capture Routineπ'* Walt Mayo 1993, 1:3627/101    DATA:803-650-8315    VOICE:803-650-0140π'* PowerBasic 3.0π'* This file seems to work great in most situations.π'* It does need some error-trapping added for existing files, so beware.π'* *********************************************************************π π$COMPILE EXE                  ' this tells PB to make a standalone EXEπ$LIB IPRINT OFF               ' allow graphic characters to printπ$OPTION CNTLBREAK OFF         ' not wise in a tsrπ πx& = SETMEM(-700000)          ' release unused memoryπ πPOPUP KEY CHR$(8,30,247)      ' ALT A is the hot keyπ πPOPUP MULTIPLEX &HC000, 254   ' reg AX and DX get this pattern as an IDπREG 1, &HC000 : REG 4, 254    ' set pattern to check for already installedπCALL INTERRUPT &H2F           ' do the multiplex interrruptπIF REG(1)<>&HC000 AND REG(4)<>254 THEN END 'we were already installedπ πSwapFile$ = LEFT$(CURDIR$,2)+"\ASCTSR.SWP"π πPRINT "PopUp .BSV grabber available as ALT-A"πREG 1, &HC001 : REG 4, 252  ' Alter AX,DX to show we were hereπPOPUP SLEEP USING EMS, SwapFile$       ' before going to sleepπ πWHILE 1=1π  x% = POS : y% = CSRLINπ  DEF SEG = &hB800π  SaveScreen$ = PEEK$(0,4000) ' save the entire screenπ  IF REG(1)=&HC000 AND REG(4)=254 THENπ    LOCATE 12,20π    PRINT "┌─────────────────────────────────────┐";π    LOCATE 13,20π    PRINT "│    BSVGRAB is already installed     │";π    LOCATE 14,20π    PRINT "└─────────────────────────────────────┘";π  ELSEπ    GOSUB GrabBSVπ  END IFπ  a$ = INPUT$(1)                               'wait for key to cancelπ  POKE$ 0, SaveScreen$ :  LOCATE y%, x%        'restore screenπ  IF UCASE$(A$)="Q" THEN IF POPUP(1) THEN END  'this uninstalls usπ  REG 1, &HC001 : REG 4, 252  ' Alter AX,DX to show we were hereπ  POPUP SLEEP                 ' before going to sleepπWENDπ πGrabBSV:π πDEF SEG = &HB800πBSAVE "c:\zdir\axax.bsv", 0, 4000πLOCATE 1, 1πCOLOR 14, 2πPRINT "                                              ";πLOCATE 1, 1πINPUT " Enter desired name for file: ", NewName$πNAME "c:\zdir\axax.bsv" as "c:\zdir\" + NewName$πLOCATE 1, 1πCOLOR 15, 3πPRINT " Press Q to remove BSVGRAB, any other key to continue "π'DEF SEGπRETURNπTim Gerchmez                   PB SUB/FUNCTION ORGANIZER      Night Owl v10 CD-ROM           Year of 1993           PB                     164  3597     SORTSUBS.BAS'SortSubs PowerBASIC Sub/Function Organizerπ'(C) Copyright 1993 by Tim Gerchmezππ'This source code is freeware - free forπ'noncommercial use.  Modified versions ofπ'this program, whether in source or .exeπ'format, may not be distributed.ππcls:print "SortSubs PowerBASIC Sub/Function Organizer"π    print "(C) Copyright 1993 by Tim Gerchmez."π    print "Freeware - No Charge for Noncommercial Use."π    printπcd$=curdir$πline input "Path: ";p$πif p$="" then goto skippathπif right$(p$,1)="\" then p$=left$(p$,len(p$)-1)πchdir p$πskippath:πif dir$("*.bas")="" thenπ    print "No BASIC Files in This Directory."π    chdir cd$π    endπend ifπcls:files "*.bas":printπline input "File to Sort (No Path): ";f$πif f$="" then chdir cd$:endπif instr(f$,".")=0 then f$=f$+".bas"πprint "Use Dividers between Subs? (Y/N): ";:locate,,1πwhile not instat:wendπa$=inkey$πif lcase$(a$)="y" then divider%=1 else divider%=0πprint:print:print "Checking File - ";πopen "i",#1,f$:ct%=0πwhile eof(1)=0πline input #1,a$:a$=lcase$(a$)πif left$(a$,4)="sub " or left$(a$,9)="function " thenπ    ct%=ct%+1πend ifπwendπclose #1:print ct%;"Subs/Functions Found."πif ct%=0 then chdir cd$:endπredim sf$(1:ct%),sg$(1:ct%):print:print "Loading Sub/Function Names...":c%=0πopen "i",#1,f$πwhile eof(1)=0πline input #1,a$:b$=lcase$(a$)πif left$(b$,4)="sub " or left$(b$,9)="function " thenπ    c%=c%+1π    sf$(c%)=a$πend ifπwendπclose #1πfor t%=1 to c%π    a$=lcase$(sf$(t%))π    if left$(a$,4)="sub " thenπ        sg$(t%)=right$(a$,len(a$)-4)π    end ifπ    if left$(a$,9)="function " thenπ        sg$(t%)=right$(a$,len(a$)-9)π    end ifπnext t%πprint "Sorting..."πarray sort sg$(),collate ucase,tagarray sf$()πerase sg$πopen "o",#2,"temp.$$$"πprint "Writing File (May Take Awhile)... ";:locate,,1ππ'Pass1 - Write Non Sub/Fn Textππclose #1πopen "i",#1,f$πwhile eof(1)=0πline input #1,a$πfor t%=1 to c%πif a$=sf$(t%) thenπ    doπ    line input #1,a$π    a$=lcase$(a$)ππ'Strip Quoted Materialπ    qm%=0:q$=""π    for zz%=1 to len(a$)π    q%=asc(mid$(a$,zz%,1))π    if q%=34 then qm%=1-qm%π    if qm%=0 and q%<>34 then q$=q$+chr$(q%)π    next zz%π    a$=q$ππ'Strip REMsπ    zz% = INSTR(a$, "rem ")π    if zz%<>0 thenπ        a$ = LTRIM$(LEFT$(a$, zz% - 1))π        if zz%=1 then a$=""π    end ifπ    zz% = INSTR(a$, "'")π    IF zz% <> 0 THENπ        a$ = LTRIM$(LEFT$(a$, zz% - 1))π        if zz%=1 then a$=""π    end ifππ'If no END SUB then loopπ    if instr(a$,"end sub") <> 0 then goto nextpointxπ    if instr(a$,"end function") <> 0 then goto nextpointxπ    loopπend ifπnext t%πif a$<>"" then print #2,a$πnextpointx:πwendππ'Pass2 - Write Sub/Fn Textπclose #1πfor t%=1 to c%πclose #1πopen "i",#1,f$πwhile eof(1)=0πline input #1,a$πif a$=sf$(t%) thenπ    print #2,chr$(13);chr$(10);π    if divider%=1 then print #2,"'";string$(78,"-")π    print #2,a$ππ    doπ    line input #1,a$π    print #2,a$π    a$=lcase$(a$)ππ'Strip Quoted Materialπ    qm%=0:q$=""π    for zz%=1 to len(a$)π    q%=asc(mid$(a$,zz%,1))π    if q%=34 then qm%=1-qm%π    if qm%=0 then q$=q$+chr$(q%)π    next zz%π    a$=q$ππ'Strip REMsπ    zz% = INSTR(a$, "rem ")π    if zz%<>0 thenπ        a$ = LTRIM$(LEFT$(a$, zz% - 1))π        if zz%=1 then a$=""π    end ifπ    zz% = INSTR(a$, "'")π    IF zz% <> 0 THENπ        a$ = LTRIM$(LEFT$(a$, zz% - 1))π        if zz%=1 then a$=""π    end ifππ'If no END SUB then loopπ    if instr(a$,"end sub") <> 0 then goto nextpointπ    if instr(a$,"end function") <> 0 then goto nextpointπ    loopπend ifπwendπnextpoint:πnext t%πclose #1:close #2πq%=instr(f$,".")πon error resume nextπz$=left$(f$,q%-1)+".bak"πkill z$πname f$ as z$πname "temp.$$$" as f$πchdir cd$πprint:print:print "Done!"πJamshid Khoshrangi             ANSI SCREEN CAPTURE TSR        FidoNet POWER_BAS Echo         10-09-95 (00:00)       PB32                   197  5047     SCR2ANS.BAS $IF 0ππ    SCR2ANS.BAS              ScreenToAnsi               SCR2ANS.BASππ                             Version  1.0ππ                Copyright 1995 by AhuraMazda(tm) Softwareππ                      Written by Jamshid Khoshrangiπππ    NOTES:ππ    Since this program uses pointers, it is PB 3.2 compatible only.ππ    This rough and dirty little TSR captures an 80x25 text screenπ    to a file called SCREEN.ANS in the root directory of the c:π    drive.  The file  contains the appropriate ANSI codes toπ    reproduce the captured screen exactly either in an ANSIπ    emulator, or through an ANSI console driver like ANSI.SYS.ππ    The codes themselves are not optimized as well as they could be.ππ    Jamshidππ$ENDIFππ$ERROR ALL OFFπ$LIB ALL OFFπ$STRING 1π$COM 0π$SOUND 1ππDEFINT A-Zππ%Black      = 0 : %LowBlue    = 1 : %LowGreen   = 2 : %LowCyan    = 3π%LowRed     = 4 : %LowMagenta = 5 : %Brown      = 6 : %LowWhite   = 7π%Gray       = 8 : %HighBlue   = 9 : %HighGreen  = 10: %HighCyan   = 11π%HighRed    = 12: %HighMagenta= 13: %Yellow     = 14: %HighWhite  = 15π%Blink      = 16: %CursorOff  = 0 : %CursorOn   = 1ππ%FOREGROUND = 1π%BACKGROUND = 2ππTYPE Videoπ  char AS BYTEπ  attr AS BYTEπEND TYPEππDIM cell AS Video PTRππ'   Program begins here!ππIF BIT(pbvScrnCard, 0) THENπ    cell = &HB000?? * 65536??πELSEπ    cell = &HB800?? * 65536??πEND IFππX& = SETMEM(-700000)πX& = SETMEM(10000)ππPOPUP KEY CHR$(12, 30, 247)   ' CTRL-ALT-AππDOππ    POPUP SLEEP USING EMSππ    IF DIR$("C:\SCREEN.ANS") <> "" THENπ        KILL "C:\SCREEN.ANS"π    END IFππ    OPEN "C:\SCREEN.ANS" FOR BINARY AS #1ππ    Temp$ = CHR$(27) + "[0m" + CHR$(27) + "[2J"ππ    PUT #1, , Temp$ππ    OldForeColor = 7π    OldBackColor = 0ππ    FOR Row = 1 TO 25ππ        $IF 0π        Temp$ = CHR$(27) + "[" + LTRIM$(RTRIM$(STR$(Row))) + "H"π        PUT #1, , Temp$π        OldForeColor = 7π        OldBackColor = 0π        OldBold = 0π        OldBlink = 0π        $ENDIFππ        FOR Column = 1 TO 80ππ            attr = @cell.attrππ            ForeColor = Attr MOD 16π            BackColor = Attr \ 16ππ            Bold  = BIT(ForeColor, 3)π            Blink = BIT(BackColor, 3)ππ            OutAnsi$ = ""ππ            IF Bold <> OldBold OR Blink <> OldBlink THENπ                OutAnsi$ = CHR$(27) + "[0"π                OldBold = Boldπ                OldBlink = Blinkπ            END IFππ            IF ForeColor <> OldForeColor OR BackColor <> OldBackColor THENπ                SELECT CASE OutAnsi$π                    CASE ""π                        OutAnsi$ = CHR$(27) + "["π                    CASE ELSEπ                        OutAnsi$ = OutAnsi$ + ";"π                END SELECTπ                IF ForeColor <> OldForeColor THENπ                    OldForeColor = ForeColorπ                    OutAnsi$ = OutAnsi$ +_π                        ToAnsiColor(ForeColor, %FOREGROUND)π                END IFπ                IF BackColor <> OldBackColor THENπ                    IF LEN(OutAnsi$) > 2 THENπ                        OutAnsi$ = OutAnsi$ + ";"π                    END IFπ                    OldBackColor = BackColorπ                    OutAnsi$ = OutAnsi$ +_π                        ToAnsiColor(BackColor, %BACKGROUND)π                END IFπ                OutAnsi$ = OutAnsi$ + "m"π                PUT #1, , OutAnsi$ππ            ELSEπ                SELECT CASE OutAnsi$π                    CASE ""ππ                    CASE ELSEπ                        OutAnsi$ = OutAnsi$ + "m"π                        PUT #1, , OutAnsi$ππ                END SELECTππ            END IFπ            PUT #1, , @cell.charππ            INCR cell, 2ππ        NEXT Columnππ    NEXT Rowππ    Temp$ = CHR$(27) + "[8m"π    PUT #1, , Temp$ππ    CLOSE #1π    BEEP 2ππLOOPππFUNCTION ToAnsiColor (_π    Attr    AS INTEGER,_π    Ground  AS INTEGER) AS STRINGππ    SELECT CASE Attrπ        CASE %Black         : Temp$ = "x0"π        CASE %LowBlue       : Temp$ = "x4"π        CASE %LowGreen      : Temp$ = "x2"π        CASE %LowCyan       : Temp$ = "x6"π        CASE %LowRed        : Temp$ = "x1"π        CASE %LowMagenta    : Temp$ = "x5"π        CASE %Brown         : Temp$ = "x3"π        CASE %LowWhite      : Temp$ = "x7"π        CASE %Gray          : Temp$ = "n;x0"π        CASE %HighBlue      : Temp$ = "n;x4"π        CASE %HighGreen     : Temp$ = "n;x2"π        CASE %HighCyan      : Temp$ = "n;x6"π        CASE %HighRed       : Temp$ = "n;x1"π        CASE %HighMagenta   : Temp$ = "n;x5"π        CASE %Yellow        : Temp$ = "n;x3"π        CASE %HighWhite     : Temp$ = "n;x7"π    END SELECTππ    SELECT CASE Groundπ        CASE %FOREGROUNDπ            REPLACE "x" WITH "3" IN Temp$π            REPLACE "n" WITH "1" IN Temp$ππ        CASE %BACKGROUNDπ            REPLACE "x" WITH "4" IN Temp$π            REPLACE "n" WITH "5" IN Temp$ππ    END SELECTππ    FUNCTION = Temp$ππEND FUNCTIONπJamshid Khoshrangi             CODE POINTER DEMONSTRATION     FidoNet POWER_BAS Echo         10-05-95 (10:04)       PB32                   223  6053     CODEPTR.BAS $IF 0πππ    CODEPTR.BAS                                             CODEPTR.BASππ                        Code Pointer Demonstrationππ                       Written by Jamshid Khoshrangiπππ    PURPOSE:ππ        This program demonstrates the power of PowerBASIC v3.2's newπ        code pointers.  In this case "power" is defined as "speed"π        and for the purposes of this demonstration, code pointers areπ        compared to a SELECT CASE statement, and both are timed withinπ        a loop.ππ    BACKGROUND NOTES:ππ        This demonstration illustrates the use of a code pointer tableπ        as a replacement for the traditionally utilized SELECT CASEπ        statement under special conditions.  Those conditions?  Well,π        if all the SELECT CASE structure does is route the program toπ        one of a selection of SUBs, and each of those SUBs accepts theπ        same parameters, or no parameters at all, such as:ππ            SELECT CASE xπ                CASE 1π                    DoTaskOneππ                CASE 2π                    DoTaskTwoππ                CASE 3π                    DoTaskThreeππ            END SELECTππ        This type of SELECT CASE is common in finite state systems.  Iπ        can personally see great use for this in two of my own programs.ππ        Even if you don't program this way now, after you see the speedπ        gains presented by code pointers under these conditions, youπ        may start asking yourself just how you can take advantage of theπ        code pointer table method!ππ        If you'd like more information on how this can be used in realπ        programs, feel free to contact me on the POWERBASIC echo inπ        Fidonet.ππ        Jamshid Khoshrangiππ$ENDIFππ'   This statement REALLY SPEEDS THINGS UP!π$ERROR ALL OFFππ$DIM ALLππDEFINT A-ZππDIM CodePtrTable (1:8) AS SHARED DWORDππ'   This type is just used for this demo... no real meaningππTYPE OurTypeπ    Alpha   AS INTEGERπ    Beta    AS STRING * 32π    Gamma   AS BYTEπ    Delta   AS LONGπEND TYPEππ'   It is important to note that each of the following SUB's thatπ'   will be in the CodePtrTable accepts the same number and typesπ'   of parameters!ππDECLARE SUB A (One AS INTEGER, Two AS STRING, Three AS OurType)πDECLARE SUB B (One AS INTEGER, Two AS STRING, Three AS OurType)πDECLARE SUB C (One AS INTEGER, Two AS STRING, Three AS OurType)πDECLARE SUB D (One AS INTEGER, Two AS STRING, Three AS OurType)πDECLARE SUB E (One AS INTEGER, Two AS STRING, Three AS OurType)πDECLARE SUB F (One AS INTEGER, Two AS STRING, Three AS OurType)πDECLARE SUB G (One AS INTEGER, Two AS STRING, Three AS OurType)πDECLARE SUB H (One AS INTEGER, Two AS STRING, Three AS OurType)ππDECLARE SUB DoTheDemo ()πDECLARE SUB InitializeTheCodePtrTable ()πDECLARE SUB RunTheSelectCaseDemo ()πDECLARE SUB RunTheCodePtrDemo ()πππ'   Demo begins here!ππDoTheDemoππENDππSUB DoTheDemo ()ππ    DIM SelectCaseEndTimer AS LONGπ    DIM CodePtrEndTimer AS LONGππ    CLSππ    VIEW TEXT (25,5)-(70,20)ππ    PRINT "Code Pointer Demonstration"π    PRINTππ    InitializeTheCodePtrTableππ    MTIMERπ    RunTheSelectCaseDemoπ    SelectCaseEndTimer = MTIMERπ    PRINT "SELECT  CASE: ", SelectCaseEndTimerππ    MTIMERπ    RunTheCodePtrDemoπ    CodePtrEndTimer = MTIMERπ    PRINT "CODE POINTER: ", CodePtrEndTimerππ    PRINTπ    PRINT "Approximately";π    PRINT  INT(1/(CodePtrEndTimer / SelectCaseEndTimer)*10)/10;π    PRINT "times faster!"π    PRINTπ    PRINT "Need I say more?"π    PRINT "Kudos to PowerBASIC version 3.2!"πππEND SUBππSUB InitializeTheCodePtrTable ()π    '   The table must be initialized!π    CodePtrTable(1) = CODEPTR32(A) : CodePtrTable(2) = CODEPTR32(B)π    CodePtrTable(3) = CODEPTR32(C) : CodePtrTable(4) = CODEPTR32(D)π    CodePtrTable(5) = CODEPTR32(E) : CodePtrTable(6) = CODEPTR32(F)π    CodePtrTable(7) = CODEPTR32(G) : CodePtrTable(8) = CODEPTR32(H)ππEND SUBπ'πSUB RunTheSelectCaseDemo ()π    DIM One     AS INTEGERπ    DIM Two     AS STRINGπ    DIM Three   AS OurTypeππ    DIM i AS INTEGER, x AS INTEGERππ    FOR i = 1 TO 1000π        FOR x = 1 TO 8ππ            ' The appropriate SUB is called by means of a SELECT CASEπ            ' statement....ππ            ' NB: I don't normally format my code like the following....π            '     I just did it here to conserve space....ππ            SELECT CASE xπ                CASE 1 : A one, two, threeπ                CASE 2 : B one, two, threeπ                CASE 3 : C one, two, threeπ                CASE 4 : D one, two, threeπ                CASE 5 : E one, two, threeπ                CASE 6 : F one, two, threeπ                CASE 7 : G one, two, threeπ                CASE 8 : H one, two, threeπ            END SELECTπ        NEXT xπ    NEXT iππEND SUBπππSUB RunTheCodePtrDemo ()ππ    DIM one     AS INTEGERπ    DIM two     AS STRINGπ    DIM three   AS OurTypeππ    DIM i AS INTEGER, x AS INTEGERππ    FOR i = 1 TO 1000π        FOR x = 1 TO 8ππ            '   The appropriate SUB is called by means of a code pointer,π            '   and the parameters are passed accordingly, using the newlyπ            '   introduced BDECL format....ππ            CALL DWORD CodePtrTable(x) BDECL (one, two, three)ππ        NEXT xπ    NEXT iππEND SUBππ'   The SUB's follow....π'   For this demo, they are just empty wrappers, but you getπ'   the idea.ππSUB A (One AS INTEGER, Two AS STRING, Three AS OurType)πEND SUBππSUB B (One AS INTEGER, Two AS STRING, Three AS OurType)πEND SUBππSUB C (One AS INTEGER, Two AS STRING, Three AS OurType)πEND SUBππSUB D (One AS INTEGER, Two AS STRING, Three AS OurType)πEND SUBππSUB E (One AS INTEGER, Two AS STRING, Three AS OurType)πEND SUBππSUB F (One AS INTEGER, Two AS STRING, Three AS OurType)πEND SUBππSUB G (One AS INTEGER, Two AS STRING, Three AS OurType)πEND SUBππSUB H (One AS INTEGER, Two AS STRING, Three AS OurType)πEND SUBπJamshid Khoshrangi             SWAP ARRAY DEMO                FidoNet POWER_BAS Echo         10-17-95 (00:00)       PB                     244  6651     SWAPARR.BAS $IF 0ππ    SWAPARR.BAS                                         SWAPARR.BASπππ                            SwapArray Demoππ                     Written by Jamshid Khoshrangiππ    PURPOSE:ππ        Have you ever wanted to just do this with arrays:ππ            SWAP ArrayOne(), ArrayTwo()ππ        rather than this:ππ            FOR i = 1 TO UBOUND(ArrayOne)π                SWAP ArrayOne(i), ArrayTwo(i)π            NEXT iππ        Well, this file demonstrates how to do it by swappingπ        array descriptors.  That's right -- just swap the descriptorsπ        in memory, and, well, the rest takes care of itself.  Fromπ        that point on, your arrays are swapped.ππ        I used my REDIM.PRESERVE code to demonstrate the speed gainsπ        that can be had by swapping just the descriptors, rather thanπ        every single data item.ππ        This code uses my ARRAYDESC32() function and Ethan Winer'sπ        SWAPMEM.ASM (turned in line).ππ    WARNINGS:ππ        Although the code checks the data types of the arrays, if youπ        attempt to swap to user defined TYPEs arrays of different TYPEsπ        but with the same overall length ... it chokes.ππ        In other words, the safeties I've added would generate run-timeπ        ERROR 10 (Duplicate definition) if you were to do this:ππ            SwapArray ArrayOne$(), ArrayTwo%(), 64ππ        Or this:ππ            TYPE UserType1π                A AS INTEGERπ            END TYPEππ            TYPE UserType2π                A AS LONGπ            END TYPEππ            DIM ArrayOne() AS UserType1π            DIM ArrayTwo() AS UserType2ππ            SwapArray ArrayOne(), ArrayTwo(), 64ππ        But NOT this:ππ            TYPE UserType1π                A AS INTEGER  ' these add up toπ                B AS INTEGER  ' an overall total of 4 bytesπ            END TYPEππ            TYPE UserType2π                A AS LONG     ' and this is four bytesπ            END TYPEππ            DIM ArrayOne() AS UserType1π            DIM ArrayTwo() AS UserType2ππ            SwapArray ArrayOne(), ArrayTwo(), 64ππ        So look out when you swap arrays of user defined TYPEs.ππ        Also note that these routines use pedal-to-the-metal tricksπ        to do what they do, so I cannot guarantee that they will runπ        under anything other than what I tested them under: PB 3.2.π        If the array descriptor size ever changes, for instance, youπ        must change the constant %ARRAY.DESC.SIZE to whatever itπ        should be....  All else will crash.  <grin>ππ        Explore and have fun with this....ππ        Jamshidππ$ENDIFππDECLARE FUNCTION ArrayInfo(BYVAL Code AS INTEGER, _π    ArrayDescriptor AS ANY) AS LONGππDEFINT A-Zππ%ARRAY.DESC.SIZE = 64ππ$IF 1ππ    DIM DYNAMIC Test(1:10) AS STRINGππ    Test(10) = "Wow!"ππ    CLSππ    MTIMERπ        REDIM.PRESERVE Test(), 32000π    PRINT "Using SwapArray: ", MTIMERππ    '   Crunch it back down for the next test...π    REDIM.PRESERVE Test(), 10ππ    MTIMERπ        REDIM.PRESERVE.OLD Test(), 32000π    PRINT "The old style: ", MTIMERππ    ENDπ$ENDIFπππSUB SwapArray (_π    BYVAL Var1 AS DWord,_π    BYVAL Var2 AS DWord,_π    BYVAL NumBytes AS Word)ππ    '   SWAPMEM.ASM was originally written by Ethan Winer and includedπ    '   with his great book on QuickBASIC....ππ    '   First, we check that we are dealing with identical data types!ππ    IF ArrayInfo(4, BYVAL Var1) <> ArrayInfo(4, BYVAL Var2) THENπ        ERROR 10    ' This is the same error PB generates when youπ                    ' try to REDIM an array into a different dataπ                    ' type than its original DIMππ    ELSEπ        '   If the arrays are of a user defined TYPE, we check toπ        '   make sure that the elements are of the same length.  Thisπ        '   will catch most goof ups, but if type different types withπ        '   identical overall lengths are swapped, this check fails toπ        '   catch the error....π        IF ArrayInfo(4, BYVAL Var1) = 12 THEN   ' user defined TYPEπ            IF ArrayInfo(2, BYVAL Var1) <> ArrayInfo(2, BYVAL Var2) THENπ                ERROR 10π            END IFπ        END IFππ    END IFππ!    Lds  SI,Var1        ;get the segmented address of the first variableπ!    Les  DI,Var2        ;and for the second variable tooπ!    Mov  CX,NumBytes    ;get the number of bytes to exchangeπ!    Jcxz ExitLabel      ;we can't swap zero bytes!π!    Cld                 ;ensure Lodsb works forwardππDoSwap:π!    Mov  AL,ES:[DI]     ;get a byte from the second variableπ!    Xchg AL,[SI]        ;swap it with the first variableπ!    Stosb               ;complete the swap and also increment DIπ!    Inc  SI             ;point to the next byte in the first variableπ!    Loop DoSwap         ;continue until doneππExitLabel:ππEND SUBππFUNCTION ARRAYDESC32 (ANY) AS DWORDππ    DIM Desc AS DWORDππ    ! mov ax, [bp+6]π    ! mov bx, [bp+8]π    ! mov Desc[0], axπ    ! mov Desc[2], bxππ    FUNCTION = DescππEND FUNCTIONπππDEFINT A-Zππ%TRUE   =   -1π%FALSE  =   NOT %TRUEππSUB REDIM.PRESERVE (InArray() AS STRING, NewMax AS INTEGER)ππArrayStart  = LBOUND (InArray)πArrayEnd    = UBOUND(InArray)ππ'   We'd better make it HUGE, just in case the original array wasπ'   huge....πDIM HUGE OutArray(ArrayStart:NewMax) AS STRINGππSELECT CASE NewMax > ArrayEndπ  CASE %TRUEπ        FOR i = ArrayStart TO ArrayEndπ            OutArray(i) = InArray(i)π        NEXT iππ    CASE %FALSEπ        FOR i = ArrayStart TO NewMaxπ            OutArray(i) = InArray(i)π        NEXT iππEND SELECTππSwapArray ARRAYDESC32(InArray()),_π          ARRAYDESC32(OutArray()),_π          %ARRAY.DESC.SIZEππEND SUBππSUB REDIM.PRESERVE.OLD (InArray() AS STRING, NewMax AS INTEGER)ππArrayStart  = LBOUND (InArray)πArrayEnd    = UBOUND(InArray)ππ'   We'd better make it HUGE, just in case the original array wasπ'   huge....πDIM HUGE OutArray(ArrayStart:NewMax) AS STRINGππSELECT CASE NewMax > ArrayEndπ  CASE %TRUEπ        FOR i = ArrayStart TO ArrayEndπ          OutArray(i) = InArray(i)π        NEXT iπ        REDIM InArray(ArrayStart:NewMax) AS STRINGπ        FOR i = ArrayStart TO ArrayEndπ            InArray(i) = OutArray(i)π        NEXT iππ    CASE FALSEπ        FOR i = ArrayStart TO NewMaxπ            OutArray(i) = InArray(i)π        NEXT iπ        REDIM InArray(ArrayStart:NewMax) AS STRINGπ        FOR i = ArrayStart TO NewMaxπ            InArray(i) = OutArray(i)π        NEXT iππEND SELECTππEND SUBπJesu's Lozano                  PANTA                          [e-mail]        10-23-95 (21:12)       PB                     43   886      PANTA.BAS   $cpu 80386π$float npxπ$lib vga,ega,iprintπ$option cntlbreakππscreen 12πfor i%=1 to 640π    for j%=1 to 480π        pset (i%,j%), i%+j% MOD 16πnext j%, i%πsalvapantaπclsπwhile inkey$="":wendπponlapanta(1)πsleep 5πKILL "panta*.jl*"πendππSUB salvapantaπincr npanta%πfor z%=1 to 5π    incr paso%, 127π    REDIM screenarray(1 TO 32767) AS INTEGERπ    GET (paso%-127, 0)-(paso%-1,479), screenarray()π    DEF SEG = VARSEG(screenarray(1))π      nomb$="panta"+LTRIM$(RTRIM$(STR$(npanta%)))+".JL"+CHR$(48+z%)π      BSAVE nomb$, VARPTR(screenarray(1)), 61440π    DEF SEGπnext z%πEND SUBππSUB ponlapanta (k%)πSCREEN 12πfor z%=1 to 5π    incr paso%, 127π    REDIM screenarray(1 TO 32767) AS INTEGERπ    DEF SEG = VARSEG(screenarray(1))π      nomb$="panta"+LTRIM$(RTRIM$(STR$(k%)))+".JL"+CHR$(48+z%)π      BLOAD nomb$, VARPTR(screenarray(1))π    DEF SEGπ    PUT (paso%-127, 0), screenarray()πnext z%πEND SUBπBrett Levin                    SOUND CARD DETECTION           QuickBASIC ScrapBook           11-12-92 (00:00)       QB, QBasic, PDS        150  4633     SBSOUND.BAS ' SBSOUND.BAS by Brett Levin 1992π'π'  These routines were made entirely from a pretty detailed (techie, butπ' not that I mind <G>) text file on programming the FM ports on the AdLib/SB.π'  You are free to use this in any program what so ever, as long as youπ' give credit where credit is due.. (stole that line from Rich!) :)π πDEFINT A-ZπDECLARE FUNCTION DetectCard% ()πDECLARE SUB SBInit ()πDECLARE SUB WriteReg (Reg%, Value%)πDECLARE SUB SBPlay (note%)π πCONST false = 0, true = NOT falseπ πSCREEN 0: CLSπ πIF DetectCard = true THENπ  PRINT "AdLib-compatible sound card detected."πELSEπ  PRINT "Unable to find/detect sound card."π  BEEPπ  SYSTEMπEND IFπPRINT " Initalizing...";π πSBInitπ πPRINT " Done."π πFOR nt = 0 TO 255πSBPlay ntπNEXT ntπ πPRINTπPRINT "  These routines only support one channel/voice of the FM chip, but"πPRINT "eventually I may fix them so you can have a bunch o' instruments on"πPRINT "at once.  I'd also like to write a replacement for SBFMDRV.COM, but"πPRINT "that's far off, and probably not in QB anyway.  This is too fast"πPRINT "compiled, so if you are going to use it in anything, add a delay."πPRINT "                                  Enjoy!         -Brett 11/12/92"πPRINTπ πFOR nt = 255 TO 0 STEP -1πSBPlay ntπNEXT ntπ πPRINT "[Press any key to end]"πSLEEPπ πCALL WriteReg(&HB0, &H0)  'Makes sure no extra sound is left playingπ πFUNCTION DetectCard%π π'  Purpose:   Detects an AdLib-compatible card.π'             Returns -1 (true) if detected and 0 (false) if not.π'  Variables: Nopeπ πCALL WriteReg(&H4, &H60)πCALL WriteReg(&H4, &H80)πB = INP(&H388)πCALL WriteReg(&H2, &HFF)πCALL WriteReg(&H4, &H21)π  FOR x = 0 TO 130π    A = INP(&H388)π  NEXT xπC = INP(&H388)πCALL WriteReg(&H4, &H60)πCALL WriteReg(&H4, &H80)πSuccess = 0πIF (B AND &HE0) = &H0 THENπ  IF (C AND &HE0) = &HC0 THENπ    Success = -1π  END IFπEND IFπDetectCard% = Successπ πEND FUNCTIONπ πSUB SBInitπ'  Initialize the sound cardπ π'(This is the "quick-and-dirty" method; what it's doing is zeroing outπ'  all of the card's registers.  I haven't had any problems with this.)π πFOR q = 1 TO &HF5π  CALL WriteReg(q, 0)πNEXT qπ πEND SUBπ πSUB SBPlay (freq%)π π'  Purpose:      Plays a noteπ π'  Variables:    freq% - Frequency (00-FF hex)π'                duration% - Duration (n seconds) (not used)π π'  I'm still working on this part, it may be ugly, but it works <g>.π'  The first group of WriteRegs is the modulator, the second is theπ'  carrier.π'  If you just want to know how to create your own instrument, play aroundπ'  with the second values in the first four calls to WriteReg in each group.π'  :-)  Have fun!  - Brettπ πCALL WriteReg(&H20, &H7)    ' Set modulator's multiple to FπCALL WriteReg(&H40, &HF)    ' Set modulator's level to 40 dBπCALL WriteReg(&H60, &HF0)   ' Modulator attack: quick, decay: longπCALL WriteReg(&H80, &HF0)   ' Modulator sustain: medium, release: mediumπCALL WriteReg(&HA0, freq%)π π πCALL WriteReg(&H23, &HF)   ' Set carrier's multiple to 0πCALL WriteReg(&H43, &H0)   ' Set carrier's level to 0 dBπCALL WriteReg(&H63, &HF0)  ' Carrier attack: quick, decay: longπCALL WriteReg(&H83, &HFF)  ' Carrier sustain: quick, release: quickπCALL WriteReg(&HB0, &H20)  ' Octaveπ πCALL WriteReg(&HE0, &H0)   ' Waveform argument for Tom..π                           ' &H00 is the default, but I felt likeπ                           ' dropping it in for you.. :)π π' I originally had an extra argument, duration!, but for some reasonπ' I wanted to do the timing outside of this sub..  You can change it backπ' if needs require..π π'TimeUp! = TIMER + duation!π'WHILE TimeUp! > TIMER: WEND  ' Worst you can be off is .182 of a secondπ πEND SUBπSUB WriteReg (Reg%, Value%)π'  Purpose:   Writes to any of the SB/AdLib's registersπ'  Variables: Reg%: Register number,π'             Value%: Value to insert in registerπ'              (Note: The registers are from 00-F5 (hex))πOUT &H388, Reg     '388h = address/status port, 389h = data portπ  FOR x = 0 TO 5   ' This tells the SB what register we want to write toπ    A = INP(&H388) ' After we write to the address port we must wait 3.3msπ  NEXT xπ πOUT &H389, Value   ' Send the value for the register to 389hπ  FOR x = 0 TO 34  ' Here we must also wait, this time 23msπ    A = INP(&H388)π  NEXT xπ πEND SUBπ π'That program will produce a motorcycle engine effect.  I do have codeπ'that will play a frequency (from 0 to 800 I believe) on any of 11π'octaves, and I'm waiting for the authors permission to post it.πJames Vahn                     PC SPEAKER FREQUENCY           FidoNet QUIK_BAS Echo          Unknown Date           QB, QBasic, PDS        22   706      FREQ.BAS    'This shows how to make specific frequencies through the PCπ'speaker.  How high a note can you hear?  :-)π π'Speaker.bas - James Vahn 1:30854/20@fidonetπ'Shows the use of PC hardware to generate sound.π'π        Old = INP(&H61)     ' 8255 PPI chip. Save the original.π        OUT &H43, 182       ' 8253 Timer chip. 10110110b Channel 2, mode 3π        Port = INP(&H61)    ' get the 8255 port contents.π        OUT &H61, Port OR 3 ' enable the speaker and use channel 2.π πINPUT "Desired Frequency in Hz"; HzπDivisor = 1193180 / HzπLSB = Divisor MOD 256πMSB = Divisor \ 256π πOUT &H42, LSBπOUT &H42, MSBπ πPRINT "Press any to stop"πWHILE INKEY$ = "": WENDπOUT &H61, Old  ' turn it off.πUnknown Author(s)              TURN PC SPEAKER OFF            TURN,PC,SPEAKER,OFF            Unknown Date           QB, QBasic, PDS        21   652      NOSOUND.BAS '  > Does anyone know how to turn the speaker off?π'  > I thought there would be a port address for the speaker butπ'  > I can't find the address.ππ'Here's something I picked up somewhere.  Unfortunately, I can't creditπ'it:ππDEFINT A-ZππDECLARE SUB NoSound ()ππ'***********************************************************************π'* SUB NoSoundπ'*π'* PURPOSEπ'*    Turns off the continuous tone.π'***********************************************************************πSUB NoSound STATICπ   C% = INP(&H61)                            'mask off speakerπ   OUT &H61, (C% AND &HFC)                   '   output from timerπEND SUBπJos Szabo                      WAV PLAYER                     BASIC Archives HomePage        Unknown Date           QB, QBasic, PDS        63   2147     WAVPLAY.BAS DECLARE SUB SetVoice (OnOff%)πCLSπ'-Div.Init (maybe you get the filename from commandline?π  VocFile$ = "C:\sounds\hey!.wav"       ' input-fileπ  FILES "c:\sounds\*.*"π  PRINTπ  INPUT "Please enter a file path and name (.WAV):  ", VocFile$π  VocFile$ = "c:\sounds\" + VocFile$ + ".wav"π  VocFile% = FREEFILE             ' .π  Delay% = 11                      ' value for delayππ'-open the voc-fileπ  OPEN VocFile$ FOR BINARY AS #VocFile%ππ'-parameters for copy-to-soundblasterπ  Bytes& = LOF(VocFile%)          ' number of bytesππ  BytesRemaining& = Bytes&        ' number of remaining bytesπ  BufferMax% = &H7F00             ' largest bufferπ  Buffer$ = SPACE$(BufferMax%)    ' create bufferππ  SetVoice 1                      ' Soundblaster onππ'-read {BufferMax%} bytes from disc, output on SBπ  DOπ     BytesRemaining& = BytesRemaining& - BufferLen%π     IF BytesRemaining& = 0 THEN EXIT DO ' nothing left over?π     IF BytesRemaining& > BufferMax% THEN ' how many bytes?π        BufferLen% = BufferMax%          'π     ELSEπ        BufferLen% = BytesRemaining&     ' remaining (<BufferMax%)..π        Buffer$ = SPACE$(BufferLen%)     ' ..throw it into SB :-)π     END IFππ     GET #VocFile%, , Buffer$            ' read bufferπ     DEF SEG = VARSEG(Buffer$)           ' get address of bufferπ     VOff% = SADD(Buffer$)               ' .ππ     FOR t% = 1 TO BufferLen%            ' output od {bufferlen%}π         'FOR qq% = 1 TO Delay: NEXT qq% ' delayπ         WAIT &H22C, &H80, &HFF         ' wait for data-readyπ         OUT &H22C, &H10π         WAIT &H22C, &H80, &HFFπ         OUT &H22C, PEEK(VOff%)π         VOff% = VOff% + 1π     NEXT t%πππ  LOOP WHILE INKEY$ = ""ππ  SetVoice 0                            ' SB offπ  CLOSE #VocFile%                       ' close fileπ  END                                   ' .. good bye :-)ππSUB SetVoice (OnOff%)π    IF OnOff% THENπ       WAIT &H22C, &H80, &HFF       ' wait for data-ready on SBπ       OUT &H22C, &HD1              ' ONπ    ELSEπ       WAIT &H22C, &H80, &HFFπ       OUT &H22C, &HD3              ' OFFπ    END IFπEND SUBπJos Szabo                      SB NOTE PLAYER                 BASIC Archives HomePage        Unknown Date           QB, QBasic, PDS        128  3737     NOTEPLAY.BASDECLARE SUB TickPause (Ticks%)πOPTION BASE 1πDEFINT A-ZπDIM A0$(6)πAddressPort = &H388πDataPort = &H389πFOR clport = 0 TO 244:πOUT AddressPort, clport: OUT DataPort, 0πNEXTπOUT AddressPort, &H20: OUT DataPort, &HF1πOUT AddressPort, &HDB: OUT DataPort, &HFFπOUT AddressPort, &H40: OUT DataPort, &H90πOUT AddressPort, &H60: OUT DataPort, &HF0πOUT AddressPort, &H80: OUT DataPort, &HFFπOUT AddressPort, &H23: OUT DataPort, &H1πOUT AddressPort, &H43: OUT DataPort, &H0πOUT AddressPort, &H63: OUT DataPort, &HF0πOUT AddressPort, &H83: OUT DataPort, &H77ππlittleJAZZditty:ππFOR xx = 1 TO 2π        FOR x = 1 TO 6π                GOSUB BinDeltaπ                OUT AddressPort, &HA0: OUT DataPort, A0π                OUT AddressPort, &HB0: OUT DataPort, &H30π                TickPause 2.5π                OUT AddressPort, &HB0: OUT DataPort, &H0π                TickPause .3π        NEXT xπ        FOR a = 1 TO 3π                x = 5π                GOSUB BinDeltaπ                OUT AddressPort, &HA0: OUT DataPort, A0π                OUT AddressPort, &HB0: OUT DataPort, &H30π                TickPause 4π                x = 2 + aπ                GOSUB BinDeltaπ                OUT AddressPort, &HA0: OUT DataPort, A0π                OUT AddressPort, &HB0: OUT DataPort, &H30π                TickPause 6π        NEXT aπ        OUT AddressPort, &HB0: OUT DataPort, 0πNEXT xxπFOR x = 6 TO 2 STEP -1π        GOSUB BinDeltaπ        OUT AddressPort, &HA0: OUT DataPort, A0π        OUT AddressPort, &HB0: OUT DataPort, &H30π        TickPause 4π        OUT AddressPort, &HB0: OUT DataPort, &H0π        TickPause .3πNEXT xπx = 5πGOSUB BinDeltaπOUT AddressPort, &HA0: OUT DataPort, A0πOUT AddressPort, &HB0: OUT DataPort, &H30πTickPause 16πOUT AddressPort, &HB0: OUT DataPort, &H0πENDππBinDelta:ππ    A0$(1) = "01101011"   ' 1π    A0$(2) = "10000001"   ' 2π    A0$(3) = "10011000"   ' 3π    A0$(4) = "10110000"   ' 4π    A0$(5) = "11001010"   ' 5π    A0$(6) = "11100101"   ' 6π'      b0$ = "00110000"π           '  xx^   ^      /2 unused/1 on-off/3 octave/2 fnum-hiπ           '  xxOoctFmbitππ    bn$ = A0$(x): rBn$ = "": GOSUB BtD: A0 = DecπRETURNππBtD:ππDec = 0!πIF LEN(bn$) <> 8 THEN RETURNπ    FOR xT = 8 TO 1 STEP -1π        rBn$ = rBn$ + MID$(bn$, xT, 1)π    NEXTππ    FOR xT = 0 TO 7π        BD = VAL(MID$(rBn$, xT + 1, 1))π        IF BD THEN Dec = Dec + 2 ^ xTπ    NEXTπRETURNππ'π'  ZDDDDDDBDDDDDDDDDDDBDDDDDDDDDDBDDDDDBDDDDDDDDDDD?π'  3      3           3          3F-H  3 F-NUMBER L3π'  3 NOTE 3 FREQUENCY 3 F-NUMBER CDDDDDEDDDDDDDDDDD4π'  3      3           3          3  10 3 76543210  3π'  CDDDDDDEDDDDDDDDDDDEDDDDDDDDDDEDDDDDEDDDDDDDDDDD4π'  3  C#  3   277.2   3    363   3  01 3 01101011  3π'  3  D   3   293.7   3    385   3  01 3 10000001  3π'  3  D#  3   311.1   3    408   3  01 3 10011000  3π'  3  E   3   329.6   3    432   3  01 3 10110000  3π'  3  F   3   349.2   3    458   3  01 3 11001010  3π'  3  F#  3   370.0   3    485   3  01 3 11100101  3π'  @DDDDDDADDDDDDDDDDDADDDDDDDDDDADDDDDDDDDDDDDDDDDYπ'ππDEFSNG A-ZπSUB TickPause (Ticks%) STATICπDEFINT A-Zππ    ' Ticks%        The number of ticks to delay.  There are 18.2 ticksπ    '               per second.  This routine returns the ticks as anπ    '               integer - it does not use QB's floating pointπ    '               routine.ππ    TestTick = 0ππ    DEF SEG = zeroπ    WHILE TestTick < Ticksππ        lastTick = Tickπ        Tick = PEEK(&H46C)     'Get a tick from the clock.ππ        '   ---- Prevents endless loop when rolling past midnight.π        IF lastTick <> Tick THEN TestTick = TestTick + 1ππ    WENDπ    DEF SEGππEND SUBπMultiple Authors               RPG MUSIC SAMPLES              Eblana-l                       05/95 (00:00)          QB, QBasic, PDS        178  5037     RPGMUSIC.BAS' The Eblana-l collection of Final Fantasy RPG Music Samplesππ'Date: Tue May 23 15:50:04 1995π'From: [e-mail]π'Subject: Qbasic Cyanπ'To: [e-mail]πππPRINT "CYAN'S SONG PROGRAMMED BY FuSoYa"πPLAY "<L4F>DL2C<L8B-AL4FL4G P4"πPLAY "L4F>DL2C<L8B-AL8FAL4G P4"πPLAY "L4F>DL2C<L8B-AL4FL1G"ππ'FuSoYaππ'Date: Sat May 27 23:44:13 1995π'From: [e-mail] (John Risser)π'Subject: FF3 Overworld music - final buildπ'To: [e-mail]π'Reply-To: [e-mail] (John Risser)πππ'FF3 Overworld/Beginning Credits Song - Final BetaπPLAY "O2MSGB->D<GGB->D<GGB->D<GGB->D>"πPLAY "MNO3G8A8B-8O4D8O3MLB-1MNB-2A8G8A2MLD1MND2"πPLAY "O3G8A8B-8O4D8O3MLB-1MNB-2A8G8A2O4MLD1MND2"πPLAY "O3B-8O4C8D8F8MLD1MND2C8<B-8>C2<MLF1MNF2"πPLAY "O3B-8A8MLG1G2MNB-8A8MLG1MNG2"πPLAY "MNO3G8A8B-8O4D8O3MLB-1MNB-2A8G8A2MLD1MND2"πPLAY "O3G8A8B-8O4D8O3MLB-1MNB-2A8G8A2O4MLD1MND2"πPLAY "O3B-8O4C8D8F8MLD1MND2C8<B-8>C2<MLF1MNF2"πPLAY "O3B-8A8MLG1G2MNB-8A8MLG1MNG2"πPLAY "O3B-8>C8D8F8MLD1MND2C8<B-8>C2<MLF1MNF2"πPLAY "O3B-8>C8D8F8MLD1MND2C8<B-8>C2MLF1MNF2"πPLAY "MNO3G8A8B-8O4D8O3MLB-1MNB-2A8G8A2MLD1MND2"πPLAY "O3B-8A8MLG1G2MNB-8A8MLG1MNG2"πPLAY "MLO3D16G16B-16>D1D2MND+8D8C+2<MLA1A"πPLAY "MLO3D16G16B-16>C1C1C2MNC4C4<B-4F+4MLG1G1G1G2<G1"ππ'by John Risserπ'Date: Sat May 20 10:34:23 1995π'From: [e-mail]π'Subject: Qbasic again. . .π'To: [e-mail]πππPRINT "HERE'S A LITTLE SONG I WROTE ON QBASIC"πPLAY "<F>L3DL4DL8C<B-AB->L1F P8 L4GAB-L2DL4EF"πPRINT "HOPE YOU LIKED IT; I WROTE IT UP IN FIVE MINUTES!"πPRINT "                    FuSoYa"ππ'Date: Sun May 21 20:43:38 1995π'From: [e-mail]π'Subject: QBasic - Kefka's Themeπ'To: [e-mail]πππ1 REM Kefka Theme - Nora E. Stevensπ2 PLAY "t80mso2d8e8f8g8a8f8b-8a16g16a8f8e8f16g16f8d8c#8d16e16d8mn<b-8a8b-8a8b-8p8"π3 PLAY "a8>d8e8f8g8a8f8b-8a16g16a8f8e8f16g16f8d8c#8d16e16d8mn<b-8a8b-8a8b-8"ππ'.\\ππ'Date: Tue May 23 11:59:37 1995π'From: [e-mail]π'Subject: QBasic - Menacing music from FF3π'To: [e-mail]πππ1 REM Menacing-type Theme - Nora E. Stevensπ2 PLAY "O1Mn>e-8.msP16<b8a-8.P8"π3 PLAY "a-8b-8>d-8<b8b-8g8a-8a-8a-8"π4 PLAY "mn>e-8.msP16<b8a-8.P8"π5 PLAY "A-8E8E-8B8..A-8"ππ'.\\ππ'Date: Sun May 21 20:45:52 1995π'From: [e-mail]π'Subject: QBasic - Oh My Hero mk. IIπ'To: [e-mail]πππ1 REM Oh My Hero - Nora E. Stevensπ2 PLAY "mlo3e4f4g4.mnc2p8mle4.g4mnb4b2p8mla4b4mn>c4.c4<mlb4.a4.g2p8"π3 PLAY "mng4g4.mlf4e4f4.p8mnf4f4.mle4e-4e4.p8"π4 PLAY "mne4e4.e4mle-4.d-4e-4e2mng2p8"π5 PLAY "mlo3e4f4g4.mnc2p8mle4f4g4mnb4b4.p8mla4b4mn>c4.c4<mlb4.a4.g2p8"π6 PLAY "mng4g4.mlf4e4f4.p8mnf4f4.mle4e-4e4.p8"π7 PLAY "mne4.e4mld4.c4d4c2p8mne4.e4mld4.c4d4c2."ππ'.\\ππ'Date: Fri May 19 20:00:18 1995π'From: [e-mail]π'Subject: Qbasic againπ'To: [e-mail]πππPRINT "HERE'S ANOTHER ONE. . . "πPLAY "<L4FL4A>C<L4F P4 L4GA>CL2E L4DEL2FL4FEDC P4 CCL8<B-AL2B- P4L4B-B-L8AG#L4A P4 L4AAFAL3>C"πPRINT "THE OPERA FROM FF3. . . . . . . .SORTA"πPRINT "FuSoYa"ππ'FuSoYaππ'Date: Sun May 21 20:45:53 1995π'From: [e-mail]π'Subject: QBasic - Overworld mk. IIπ'To: [e-mail]πππ1 REM Overworld Theme - Revised by Nora E. Stevensπ2 PLAY "MNO3G8A8B-8O4D8O3B-1A8G8A2D1"π3 PLAY "O3G8A8B-8O4D8O3B-1A8G8A2O4D1"π4 PLAY "O3B-8O4C8D8F8D1C8<B-8>C2<F1"π5 PLAY "O3B-8A8MLG1G4MNB-8A8MLG1G4P4"π6 PLAY "MNO3G8A8B-8O4D8O3B-1A8G8A2D1"π7 PLAY "O3G8A8B-8O4D8O3B-1A8G8A2O4D1"π8 PLAY "O3B-8O4C8D8F8D1C8<B-8>C2<F1"π9 PLAY "O3B-8A8MLG1G4MNB-8A8MLG1G4P4"π10 PLAY "O3B-8O4C8D8F8D1C8<B-8>C2<F1"π11 PLAY "O3B-8O4C8D8F8D1C8<B-8>C2F1"π12 PLAY "MNO3G8A8B-8O4D8O3B-1A8G8A2D1"π13 PLAY "O3B-8A8MLG1G4MNB-8A8MLG1G4"ππ'.\\ππ'Date: Tue May 23 13:48:57 1995π'From: [e-mail]π'Subject: More QBASIC...π'To: [e-mail]πππ'Here's Shadow's music:ππPLAY "o4cl2g.l8gfe-dl4cl8de-l4<b-l2>c."πPLAY "l4cl2g.l8gfe-dl4cl8dcl4<b-l2>c."πPLAY "o4l8g.l16gl2b-.l16g.a.b-.l1al8b-al4gl8agl4fl1g"πPLAY "o4l4cl2g.l8gfe-dl4cl8de-l4<b-l2>c."ππ'Phyrππ'Date: Tue May 23 15:46:52 1995π'From: [e-mail]π'Subject: Qbasic-Setzerπ'To: [e-mail]πππ'Here's a little bit of it. . . πPRINT "FF3'S BEST SONG PROGRAMMED BY FuSoYa"πPLAY "L4<C>L8DC<L2B P8 L8GA>C<BAL4GA"πPLAY "L4<C>L8DC<L2B P8 L8GA>C<BA"ππ'FuSoYaππ'From [e-mail] Mon Sep 11 11:57:32 1995π'Date: Sun, 10 Sep 95 15:03:17 EDTπ'From: John Risser <[e-mail]>π'To: [e-mail], [e-mail]π'Subject: Shadow's music - final betaπππ' Shadow's music - Final betaπ' by John Risserπ' (no offense FuSoYa, but it's better than yours)π1πPLAY "T161O1MSE4P2P4E4E4E4P1P4"πPLAY "O1MSE4P2P4E4E4E4P1"πPLAY "MNO4E4MLB1MNB8A4G4F+4E4F+4G4D4MLE1MNE1P2P4"πPLAY "O4E4MLB1MNB8A4G4F+4E4F+4O3B4O4D4MLE1MNE1P2P4"πPLAY "O4B4>MLD1MN<B8>C#8D4MLC#1MNC#4P8."πPLAY "O5D4C#4<B4>C#4<F+4A4MLB1MNP4"πPLAY "O4E4MLB1MNB8A4G4F+4E4F+4G4D4MLE1.MNE2P2P4."πGOTO 1ππ'--π'. <-- The super-string of all sigs!πKrisjanis Gale                 MUSIC COMPOSER                 FidoNet QUIK_BAS Echo          Year of 1993           QB, QBasic, PDS        288  6779     MUSICOMP.BASDECLARE SUB Instructions ()πDECLARE SUB MusicConfig ()πDECLARE SUB SaveFile (PlayIt$)πDECLARE SUB LoadFile (PlayIt$, found$)πDECLARE SUB ComposeMusic (PlayIt$)πDOπCLSπPRINT "The MusicComposer"πPRINT "Programmed by Krisjanis 'The Hacker' Gale"πPRINTπPRINT "Type:": PRINTπPRINT "1) To get instructions."πPRINT "2) To compose a new music."πPRINT "3) To replay newly made or loaded music."πPRINT "4) To save music currently in memory."πPRINT "5) To load previously composed music from a file."πPRINT "6) To Quit.": PRINTπLOCATE 23, 1πPRINT "Press number of selection..."πDOπLET in$ = INKEY$πLOOP WHILE in$ = ""πSELECT CASE in$πCASE "1"π  CALL InstructionsπCASE "2"π  IF PlayIt$ <> "" THENπ    CLSπ    INPUT "Erase what exists?(y/n)...>", erase$π    IF erase$ = "y" THENπ      CLSπ      LET PlayIt$ = ""π      CALL ComposeMusic(PlayIt$)π    END IFπ    IF erase$ = "n" THENπ      INPUT "Add on to what exists?(y/n)...>", addon$π      IF addon$ = "y" THENπ        CLSπ        PRINT PlayIt$π        CALL ComposeMusic(PlayIt$)π      END IFπ    END IFπ  ELSEπ    CLSπ    CALL ComposeMusic(PlayIt$)π  END IFπCASE "3"π  CLSπ  INPUT "Loop music indefinately?(y/n)...>", yesno$π  IF yesno$ = "y" THENπ    PRINT "Press ESC to stop music loop."π    DOπ      PLAY PlayIt$π    LOOP UNTIL INKEY$ = CHR$(27)π  END IFπ  IF yesno$ = "n" THENπ    PLAY PlayIt$π  END IFπCASE "4"π  CALL SaveFile(PlayIt$)πCASE "5"π  CALL LoadFile(PlayIt$, found$)πCASE "6"π  LOCATE 22, 1π  PRINT "Thanks for using my program."π  PRINT "                 --Krisjanis 'The Hacker' Gale--"π  SLEEP 1πEND SELECTπLOOP UNTIL in$ = "6"πENDππSUB ComposeMusic (PlayIt$)πPRINT "Play!"πDOπSLEEPπLET in$ = INKEY$πSELECT CASE in$πCASE "a"π  PLAY "c"π  PRINT "C ";π  LET PlayIt$ = PlayIt$ + "c"πCASE "w"π  PLAY "c#"π  PRINT "C# ";π  LET PlayIt$ = PlayIt$ + "c#"πCASE "s"π  PLAY "d"π  PRINT "D ";π  LET PlayIt$ = PlayIt$ + "d"πCASE "e"π  PLAY "e-"π  PRINT "E- ";π  LET PlayIt$ = PlayIt$ + "e-"πCASE "d"π  PLAY "e"π  PRINT "E ";π  LET PlayIt$ = PlayIt$ + "e"πCASE "f"π  PLAY "f"π  PRINT "F ";π  LET PlayIt$ = PlayIt$ + "f"πCASE "t"π  PLAY "f#"π  PRINT "F# ";π  LET PlayIt$ = PlayIt$ + "f#"πCASE "g"π  PLAY "g"π  PRINT "G ";π  LET PlayIt$ = PlayIt$ + "g"πCASE "y"π  PLAY "a-"π  PRINT "A- ";π  LET PlayIt$ = PlayIt$ + "a-"πCASE "h"π  PLAY "a"π  PRINT "A ";π  LET PlayIt$ = PlayIt$ + "a"πCASE "u"π  PLAY "b-"π  PRINT "B- ";π  LET PlayIt$ = PlayIt$ + "b-"πCASE "j"π  PLAY "b"π  PRINT "B ";π  LET PlayIt$ = PlayIt$ + "b"πCASE "k"π  PLAY ">c<"π  PRINT "HiC ";π  LET PlayIt$ = PlayIt$ + ">c<"πCASE ","π  PRINT "1/12 note "π  PLAY "l6"π  LET PlayIt$ = PlayIt$ + "l6"πCASE "."π  PRINT "3/2 len. ";π  LET PlayIt$ = PlayIt$ + "."πCASE "["π  PLAY "<"π  PRINT "OctvDn ";π  LET PlayIt$ = PlayIt$ + "<"πCASE "]"π  PLAY ">"π  PRINT "OctvUp ";π  LET PlayIt$ = PlayIt$ + ">"πCASE "p"π  PLAY "n0"π  PRINT "Pause ";π  LET PlayIt$ = PlayIt$ + "n0"πCASE "1"π  PLAY "l1"π  PRINT "Whole ";π  LET PlayIt$ = PlayIt$ + "l1"πCASE "2"π  PLAY "l2"π  PRINT "Half ";π  LET PlayIt$ = PlayIt$ + "l2"πCASE "3"π  PLAY "l4"ππ  PRINT "Quarter ";π  LET PlayIt$ = PlayIt$ + "l4"πCASE "4"π  PLAY "l8"π  PRINT "Eighth ";π  LET PlayIt$ = PlayIt$ + "l8"πCASE "5"π  PLAY "l16"π  PRINT "Sixteenth ";π  LET PlayIt$ = PlayIt$ + "l16"πCASE "6"π  PLAY "l32"π  PRINT "Thirty-Second ";π  LET PlayIt$ = PlayIt$ + "l32"πCASE "7"π  PLAY "l64"π  PRINT "Sixty-Fourth ";π  LET PlayIt$ = PlayIt$ + "l64"πCASE "8"π  PLAY "ms"π  PRINT "Staccato ";π  LET PlayIt$ = PlayIt$ + "ms"πCASE "9"π  PLAY "mn"π  PRINT "Normal ";π  LET PlayIt$ = PlayIt$ + "mn"πCASE "0"π  PLAY "ml"π  PRINT "Lengato ";π  LET PlayIt$ = PlayIt$ + "ml"πCASE "="π  INPUT "Octave(0-6)...>", octaveπ  PLAY "o" + STR$(octave)π  LET PlayIt$ = PlayIt$ + "o" + MID$(STR$(octave), 2, LEN(STR$(octave)))πCASE "-"π  INPUT "Tempo?(32-255 qtr.notes/sec.)...>", tempoπ  PLAY "t" + STR$(tempo)π  LET PlayIt$ = PlayIt$ + "t" + MID$(STR$(tempo), 2, LEN(STR$(tempo)))πEND SELECTπLOOP UNTIL in$ = CHR$(27)πEND SUBππSUB InstructionsπCLSπPRINT "Welcome to my music composition program."πPRINT "Summary of menu choices:"πPRINT "1) Displays this help file."πPRINT "2) Allows you to create new music and store it in RAM."πPRINT "   (See summary of keys below.)  When you are done, press ESC."πPRINT "3) Replays music that was just composed and is still in RAM."πPRINT "4) Allows you to save newly composed music to a file."πPRINT "5) Lets you load a file that you already saved so that you don't have"πPRINT "   to start over and recompose the music."πPRINT "6) Like it says.  QUITS the program."πLOCATE 11, 1πPRINTπPRINT "Notes:"πPRINT "a: C"; TAB(10); "w: C#"; TAB(20); "s: D"; TAB(30); "e: E-";πPRINT TAB(40); "d: E"; TAB(50); "f: F"; TAB(60); "t: F#"πPRINT "g: G"; TAB(10); "y: A-"; TAB(20); "h: A"; TAB(30); "u: B-"; TAB(40); "j: B";πPRINT TAB(50); "k: hiC"πPRINTππPRINT "Functions:"πPRINT ",: 1/12 note (for eighth note triplets)"πPRINT ".: 3/2 length"; TAB(20); "p: pause"πPRINT "=: Select octave"; TAB(25); "[: Lowers octave"; TAB(50); "]:"; Raises; octave; ""πPRINT "-: Change tempo"; TAB(25); "1-7: Changes note length (1: whole, 2: half, etc.)"πPRINT "8: Staccatto"; TAB(25); "9: Normal"; TAB(50); "0: Lengato"πPRINTπLOCATE 23, 1πPRINT "Press any key to continue..."πDOπLOOP WHILE INKEY$ = ""πEND SUBππSUB LoadFile (PlayIt$, found$)πCLSπDOπCHDIR "\"πFILES "*."πINPUT "Please enter PATH where you saved the file...>", path$πCHDIR path$πFILES "*."πINPUT "Is the file there?(y/n)...>", found$πIF found$ = "n" THENπ  INPUT "Give up search?(y/n)...>", abort$πEND IFπLOOP UNTIL found$ = "y" OR abort$ = "y"πIF found$ = "y" THENπINPUT "Please specify which file (from those above)...>", name$πOPEN name$ FOR INPUT AS #1πINPUT #1, PlayIt$πCLOSE #1πEND IFπEND SUBππSUB SaveFile (PlayIt$)πCLSπINPUT "Will this be a NEW or PREVIOUS file?(n/p)...>", neworprev$πIF neworprev$ = "n" THENπ  CHDIR "\"π  FILES "*."π  INPUT "Please enter PATH to save file to...>", path$π  CHDIR path$π  INPUT "Enter new file name (please use no file extension!)...>", name$πEND IFπIF neworprev$ = "p" THENπ  DOπ  CHDIR "\"π  FILES "*."π  INPUT "Please enter PATH where you saved the file...>", path$π  CHDIR "\"π  CHDIR path$π  FILES "*."π  INPUT "Is the file there?(y/n)...>", found$π    IF found$ = "n" THENπ      INPUT "Give up search?(y/n)...>", abort$π    END IFπ  LOOP UNTIL found$ = "y" OR abort$ = "y"π  IF found$ = "y" THENπ    INPUT "Enter previous file name (it WILL be overwritten!)...>", name$π  END IFπEND IFπOPEN name$ FOR OUTPUT AS #1πPRINT #1, PlayIt$πCLOSE #1πEND SUBππUnknown Author(s)              WILLIAM TELL OVERTURE          FidoNet QUIK_BAS Echo          09/95 (00:00)          QB, QBasic, PDS        67   4143     WILLTELL.BAS'WILLTELL.BAS   the William Tell Overture (Lengthy version)ππPLAY "MST150L4O2BP8L16BBL4BP8L16BBL8BG+EG+BG+B>E<BG+EG+BG+B"πPLAY ">EL4<BP8L16BBL4BP8L16BBL4BP8L16BBL4BP8L16BBL8BL16BBL8B"πPLAY "BBL16BBL8BBBL16BBL8BBBL16BBL8BBL2BBL8BP8P4P4P8L16<BBL8B"πPLAY "L16BBL8BL16BBL8>EF+G+L16<BBL8BL16BBL8>EL16G+G+L8F+D+<B"πPLAY "L16BBL8BL16BBL8BL16BBL8>EF+G+L16EG+L4BL16BAG+F+L8EG+E"πPLAY "L16>BBL8BL16BBL8BL16BBL8>EF+G+L16<BBL8BL16BBL8>EL16G+"πPLAY "G+L8F+D+<BL16BBL8BL16BBL8BL16BBL8>EF+G+L16EG+L4BL16BA"πPLAY "G+F+L8EG+EL16<G+G+L8G+L16G+G+L8G+L16G+G+L8G+>C+<G+>C+"πPLAY "<G+>C+<G+F+ED+C+L16G+G+L8G+L16G+G+L8G+L16G+G+L8G+>C+<G+"πPLAY ">C+<G+>C+<BA+BA+BL16G+G+L8G+L16G+G+L8G+L16G+G+L8G+>C+"πPLAY "<G+>C+<G+>C+<G+F+ED+C+L16G+G+L8G+L16G+G+L8G+L16G+G+L8G+"πPLAY ">C+<G+>C+<G+>C+<BA+BL16<BBL8BL16F+F+L8F+L16F+F+L8F+G+"πPLAY "AL4F+L8AG+L4EL8G+F+F+F+L16>F+F+L8F+L16F+F+L8F+G+AL4F+"πPLAY "L8AG+L4EL8G+F+L16<BBL8BL16<BBL8BL16BBL8BL16BBL8>EF+G+"πPLAY "L16<BBL8BL16BBL8>EL16G+G+L8F+D+<BL16BBL8BL16BBL8BL16B"πPLAY "BL8>EF+G+L16EG+L4BL16BAG+F+L8EG+EL16>BBL8BL16BBL8BL16B"πPLAY "BL8>EF+G+L16<BBL8BL16BBL8>EL16G+G+L8F+D+<BL16BBL8BL16B"πPLAY "BL8BL16BBL8>EF+G+L16EG+L4BL16BAG+F+L8EG+EL64<EFGAB>CD"πPLAY "L8EL16EEL8EEL4G+.L8F+ED+EC+L16<B>C+<B>C+<B>C+D+E<ABAB"πPLAY "AB>C+D+<G+AG+AG+AB>C+<F+G+F+G+F+G+F+G+F+G+F+D+<B>B>C+"πPLAY "D+L8ED+EC+L16<B>C+<B>C+<B>C+D+E<ABABAB>C+D+<G+AG+AG+A"πPLAY "B>C+<F+G+F+G+F+AF+EL8EP8L4C+L16C+<C>C+<C>D+C+<BAAG+EC+"πPLAY "C+C+C+C+ED+<CG+G+G+G+G+G+>C+EG+>C+C+C+C+C+<C>C+<C>D+C+"πPLAY "<BAAG+EC+C+C+C+C+ED+<CG+G+G+G+G+G+>C+EG+>C+ED+C+D+<CG+"πPLAY "G+G+>G+EC+D+<CG+G+G+>G+EC+D+<BG+G+A+GD+D+G+GG+GG+AG+F+"πPLAY "E<BA+B>E<B>F+<B>G+ED+EG+EAF+B>G+F+ED+F+EC+<B>C+<B>C+D+"πPLAY "EF+G+<ABAB>C+D+EF+<G+AG+AC>C+D+E<F+G+F+G+F+G+F+G+F+G+"πPLAY "F+D+<BC>C+D+E<BA+B>E<B>F+<B>G+ED+EG+EAF+B>G+F+ED+F+EC+"πPLAY "<B>C+<B>C+D+EF+G+<ABAB>C+D+EF+<G+AG+AB>C+D+E<F+>C+<C>C+"πPLAY "D+C+<AF+E>EF+G+AB>C+D+L8EL16EEL8EEL4G+.L8FED+EC+L16<B"πPLAY ">C+<B>C+<B>C+D+E<ABABAB>C+D+<G+AG+AG+AB>C+<F+G+F+G+F+"πPLAY "G+F+G+F+G+F+D+<B>B>C+D+L8EL16EEL8EEL4G+.L8F+ED+EC+L16<B"πPLAY ">C+<B>C+<B>C+D+E<ABABAB>C+D+<G+AG+AG+AB>C+<F+G+F+G+F+"πPLAY "AG+F+L8E<B>EL16G+G+L8G+L16G+G+L8G+L16G+G+L8G+>C+<G+>C+"πPLAY "<G+>C+<G+F+ED+C+L16G+G+L8G+L16G+G+L8G+L16G+G+L8G+>C+<G+"πPLAY ">C+<G+>C+<BA+BA+BL16G+G+L8G+L16G+G+L8G+L16G+G+L8G+>C+"πPLAY "<G+>C+<G+>C+<G+F+ED+C+L16G+G+L8G+L16G+G+L8G+L16G+G+L8G+"πPLAY ">C+<G+>C+<G+>C+<BA+BA+BL16<F+F+L8F+L16F+F+L8F+G+AL4F+"πPLAY "L8AG+L4EL8G+F+B<BL16>F+F+L8F+L16F+F+L8F+G+AL4F+L8AG+L4E"πPLAY "L8G+F+L16BBL8BL16<BBL8BL16BBL8BL16BBL8>EF+G+L16<BBL8B"πPLAY "L16BBL8>EL16G+G+L8F+D+<BL16BBL8BL16BBL8BL16BBL8>EF+G+"πPLAY "L16EG+L4BL16BAG+F+L8E<B>EL16>BBL8BL16BBL8BL16BBL8>EF+"πPLAY "G+L16<BBL8BL16BBL8>EL16G+G+L8F+D+<BL16BBL8BL16BBL8BL16B"πPLAY "BL8>EF+G+L16<EG+L4BL16BAG+F+EF+G+AG+AB>C+<B>C+D+ED+EF+"πPLAY "G+A<B>A<B>A<B>A<B>A<B>A<B>A<B>A<BEF+G+AG+AB>C+<B>C+D+"πPLAY "ED+EF+G+A<B>A<B>A<B>A<B>A<B>A<B>A<B>A<BP16G+>G+<G+P16"πPLAY "D+>D+<D+P16E>E<EP16A>A<AP16G+>G+<G+P16D+>D+<D+P16E>E<E"πPLAY "P16A>A<A>G<G>G<G>G<G>G<GL8>GECEL16G+<G+>G+<G+>G+<G+>G+"πPLAY "<G+L8>G+E<B>EL16G+<G+>G+<G+>G+<G+>G+<G+L8>G+FC+FL16A+"πPLAY "<A+>A+<A+>A+<A+>A+<A+L8>A+GEGBP16L16A+P16AP16G+P16F+P16"πPLAY "EP16D+P16C+P16<BP16A+P16AP16G+P16F+P16EP16D+P16F+EF+G+"πPLAY "AG+AB>C+<B>C+D+ED+EF+G+A<B>A<B>A<B>A<B>A<B>A<B>A<B>A<B"πPLAY "EF+G+AG+AB>C+<B>C+D+ED+EF+G+A<B>A<B>A<B>A<B>A<B>A<B>A"πPLAY "<B>A<BP16G+>G+<G+P16D+>D+<D+P16E>E<EP16A>A<AP16G+>G+<G+"πPLAY "P16D+>D+<D+P16E>E<EP16A>A<A>G<G>G<G>G<G>G<GL8>GECEL16G+"πPLAY "<G+>G+<G+>G+<G+>G+<G+L8>G+E<B>EL16G+<G+>G+<G+>G+<G+>G+"πPLAY "<G+L8>G+FC+FL16A+<A+>A+<A+>A+<A+>A+<A+L8>A+GEGBP16L16A+"πPLAY "P16AP16G+P16F+P16EP16D+P16C+P16<BP16A+P16AP16G+P16F+P16"πPLAY "EP16D+P16FED+ED+L8EL16BBL8BL16BBL8BL16BBL8>EF+G+L16<B"πPLAY "BL8BL16BBL8BL16BBL8>G+ABP8EF+G+P8<G+ABP8P2L16<BC>C+DD+"πPLAY "EFF+GG+AA+BC>C+D+ED+F+D+ED+F+D+ED+F+D+ED+F+D+ED+F+D+E"πPLAY "D+F+D+ED+F+D+ED+F+D+L8EL16E<E>E<E>E<EL8>EL16<B<B>B<B>B"πPLAY "<BL8>BL16G+<G+>G+<G+>G+<G+L8>GL16E<E>E<E>E<EL8>EL16EE"πPLAY "L8EEEL16<BBL8BBBL16G+G+L8G+G+G+L16EEL8EEE<B>E<B>G+EBG+"πPLAY ">E<B>E<B>G+EBG+L4>EP8L16EEL8EEEEL4EP8L16EL4EP8L16O2EL2E"πMonte Ferguson                 VOC TO SAMPLE DUMP STANDARD    FidoNet QUIK_BAS Echo          03-02-93 (00:00)       QB, QBasic, PDS        444  15256    VOC2SDS.BAS ' VOC2SDS by Monte Ferguson (C) Copyright 1993 Monte Fergusonπ'π' Notes: This code was not written to be elegant or user friendly, or to beπ' a tutorial on how to write good code - it was written to WORK the way *I*π' wanted it to.π'π' If you'd like to swipe the code or hack it, please feel free. I ask onlyπ' that you send me a copy of anything you create with it - that would be myπ' payment. Mention in your dox would be nice, too :-)π'π' Monte Fergusonπ' 1250 Anita Drive #304π' Kent, OH  44240π' Fido: 1:157/200.39π'π' Enjoy.π'π' P.S. - hardcoded stuff that's easy to change is generally marked withπ'      <<< LOOK <<π' ie, channel numbers, sample number, etc.ππDECLARE FUNCTION GetBlkLen! ()πDECLARE FUNCTION GenPath$ (FSpec$)πDECLARE FUNCTION GenSpec$ (FSpec$, DefExt$)πDECLARE FUNCTION SngToM3$ (n!)πDECLARE FUNCTION M3toDec! (m3$)πDECLARE FUNCTION Hx$ (Text$)ππDEFINT A-Zπ'π' VOC2SDS - Converts .VOC files to Sample Dump Standardπ' Copyright 1993 Monte Fergusonπ'π' First version      01-Mar-93π'πCONST Vers = "1.0"πCONST LastUpdate = "02-Mar-93"πCONST Copyright = "VOC2SDS Copyright 1993, Monte Ferguson"πCONST False = 0πCONST True = NOT FalseππTYPE VOCHeaderTypeπ  Des AS STRING * 20π  BlockOffset AS INTEGERπ  Vers AS INTEGERπ  VerComp AS INTEGERπEND TYPEππTYPE SDSHeaderTypeπ  f07e AS STRING * 2π  Channel AS STRING * 1π  One AS STRING * 1π  SampleNum AS STRING * 2π  Bits AS STRING * 1π  Period AS STRING * 3π  SLength AS STRING * 3π  SustLoopStart AS STRING * 3π  SustLoopEnd AS STRING * 3π  LoopType AS STRING * 1π  F7 AS STRING * 1πEND TYPEππTYPE SDSBLockTypeπ  f07e AS STRING * 2π  Channel AS STRING * 1π  Two AS STRING * 1π  PktCnt AS STRING * 1π  DTA AS STRING * 120π  ChkSum AS STRING * 1π  F7 AS STRING * 1πEND TYPEππππDIM VocHead AS VOCHeaderTypeπDIM SDSHead AS SDSHeaderTypeπDIM SDSBLock AS SDSBLockTypeππππFileSpec$ = GenSpec$(LTRIM$(UCASE$(COMMAND$)), "VOC")ππPRINT CopyrightπPRINT Vers + " " + LastUpdateπPRINT ""ππIF LEN(FileSpec$) > 0 THENπ  FPath$ = GenPath$(FileSpec$)π  d$ = DIR$(FileSpec$)π  DO WHILE d$ <> ""π    KY$ = INKEY$π    f$ = FPath$ + d$π    PRINT ""π    a$ = "------" + f$ + "------"π    PRINT SPACE$(40 - LEN(a$) / 2) + a$π    PRINT ""π    ' Examine the fileπ    OPEN f$ FOR BINARY AS #1π    GET #1, , VocHeadπ    IF VocHead.Des <> "Creative Voice File" + CHR$(26) THENπ      PRINT "Bogus header, not a .VOC file."π    ELSEπ      v$ = HEX$(VocHead.Vers)π      IF LEN(v$) < 4 THEN v$ = STRING$(4 - LEN(v$), "0") + v$π      v$ = LTRIM$(STR$(VAL("&H" + LEFT$(v$, 2)))) + "." + LTRIM$(STR$(VAL("&H" + RIGHT$(v$, 2))))π      PRINT "Version:"; v$π      PRINT "Offset to 1st data block:"; VocHead.BlockOffsetπ      SEEK #1, VocHead.BlockOffset + 1π      BlockCount = 0ππ      '         1         2         3         4         5         6         7         8π      '12345678901234567890123456789012345678901234567890123456789012345678901234567890π      'Blk Type                Bytes     Secs  SmplRate Pack      Otherπ      '##  \                 \ #,###,### ###.# ##,###   \       \ \                  \π      PRINT "Blk Type                Bytes     Secs  SmplRate Pack      Other"π      PRINT STRING$(79, "-")π      Converted = Falseπ        DOπ          BlockCount = BlockCount + 1π          BType$ = SPACE$(1)π          GET #1, , BType$π          SELECT CASE ASC(BType$)π            CASE 0π              BType$ = "Terminator"π              PRINT USING "##  \                 \ #,###,### ###.# ##,###   \       \ \                  \"; BlockCount; BType$; 0; 0; 0; "N/A"π              EXIT DOπ            CASE 1π              BL! = GetBlkLenπ              s! = SEEK(1)π              BType$ = "Voice Data"π              SR$ = SPACE$(1)π              GET #1, , SR$π              SR! = ASC(SR$)π              SR! = INT(1000000! / (256 - SR!) + .5)π              Secs! = INT((BL! / SR!) * 10) / 10π              Pk$ = SPACE$(1)π              π              GET #1, , Pk$π              SELECT CASE ASC(Pk$)π                CASE 0π                  PT$ = "Raw 8-bit"π                CASE 1π                  PT$ = "4-bit"π                CASE 2π                  PT$ = "2.6 bit"π                CASE 3π                  PT$ = "2 bit"π                CASE ELSEπ                  PT$ = "Unknown!"π              END SELECTπ              PRINT USING "##  \                 \ #,###,### ###.# ##,###   \       \ \                  \"; BlockCount; BType$; BL!; Secs!; SR!; PT$π              IF Pk$ <> CHR$(0) THENπ                PRINT "    ---> PACKED BLOCK, CANNOT CONVERT!"π              ELSEπ                IF NOT Converted THENπ                  PRINT "    ---> Converting...";π                  Target$ = FPath$ + d$π                  p = LEN(Target$)π                  DO WHILE p >= 1π                    IF MID$(Target$, p, 1) = "." THENπ                      EXIT DOπ                    END IFπ                    p = p - 1π                  LOOPπ                  IF p = 0 THENπ                    Target$ = Target$ + ".SDS"π                  ELSEπ                    Target$ = LEFT$(Target$, p) + "SDS"π                  END IFπ                  OPEN Target$ FOR BINARY AS #2π                  SDSHead.f07e = CHR$(&HF0) + CHR$(&H7E)π                  SDSHead.Channel = CHR$(0)         ' <<<<<<<<<<<<<<<< LOOK <<<<<<π                  SDSHead.One = CHR$(1)π                  SDSHead.SampleNum = CHR$(0) + CHR$(0)' <<<<<<<<<<<<<<<< LOOK <<<<<<π                  SDSHead.Bits = CHR$(16)           ' <<<<<<<<<<<<<<<< LOOK <<<<<<π                  SDSHead.Period = SngToM3$((1 / SR!) * 1000000000#)π                  SDSHead.SLength = SngToM3$(BL!)π                  SDSHead.SustLoopStart = SngToM3$(0)' <<<<<<<<<<<<<<<< LOOK <<<<<<π                  SDSHead.SustLoopEnd = SngToM3$(BL!)' <<<<<<<<<<<<<<<< LOOK <<<<<<π                  SDSHead.LoopType = CHR$(0)         ' <<<<<<<<<<<<<<<< LOOK <<<<<<π                  SDSHead.F7 = CHR$(&HF7)π                  PUT #2, , SDSHeadπ                  ' Now we create blocks by fetching 40 bytes of .VOC dataπ                  ' at a shot. Since 16 bits takes 3 7-bit words, that givesπ                  ' us the correct 120 bytes/block length for SDS.π                  nb! = BL! / 40π                  IF nb! <> INT(nb!) THENπ                    nb! = INT(nb!) + 1π                  END IFπ                  π                  ' Yes, this grunges the last block if it's not a multiple ofπ                  ' 40 bytes. So sue me. I *told* you this was quick and dirty! :-)π                  FOR i = 1 TO nb!π                    Pkt = (i - 1) MOD 128' Packet Countπ                    Smp$ = SPACE$(40)π                    GET #1, , Smp$π                    Chk = &H7E      ' The running checksumπ                    Chk = Chk XOR 0 ' Channel Numπ                    Chk = Chk XOR 2 ' "Two"π                    Chk = Chk XOR Pktπ                    DTA$ = ""π                    FOR j = 1 TO LEN(Smp$)π                      Byte8 = ASC(MID$(Smp$, j, 1))π                      ' This next line converts the 8-bit sample to 16 bits:π                      Byte16! = Byte8 * 256!π                      ' And this stuff divides our 16 bits into three MIDI data bytes.π                      ' The 1st bytes is 512s, the 2nd byte is 4 and the last bytes is theπ                      ' remainder (0-3) but LEFT JUSTIFIED within the 7-bit field. Hey, Iπ                      ' didn't write the standard, I just live with it! :-)π                      b1 = INT(Byte16! / 512)π                      r1! = Byte16! - (b1 * 512!)π                      b2 = INT(r1! / 4)π                      r2! = r1! - (b2 * 4)π                      b3 = r2! * 32π                      Chk = Chk XOR b1π                      Chk = Chk XOR b2π                      Chk = Chk XOR b3π                      DTA$ = DTA$ + CHR$(b1) + CHR$(b2) + CHR$(b3)π                    NEXT jππ                    SDSBLock.f07e = CHR$(&HF0) + CHR$(&H7E)π                    SDSBLock.Channel = CHR$(0)      ' <<<<<<<< LOOK <<<<<<<<<<<<π                    SDSBLock.Two = CHR$(2)π                    SDSBLock.PktCnt = CHR$(Pkt)π                    SDSBLock.DTA = DTA$π                    SDSBLock.ChkSum = CHR$(Chk)π                    SDSBLock.F7 = CHR$(&HF7)π                    PUT #2, , SDSBLockπ                    y = CSRLINπ                    x = POS(0)π                    PRINT INT((i / nb!) * 100); "%";π                    LOCATE y, xπ                  NEXT iπ                  CLOSE #2π                  PRINT "Done."π                  Converted = Trueπ                  REM Stuffπ                ELSEπ                  PRINT "(this version only converts the 1st block...)"π                END IFπ              END IFπππ              SEEK #1, s! + BL!π            CASE 2π              BL! = GetBlkLenπ              s! = SEEK(1)π              BType$ = "Voice Continuation"π              PRINT USING "##  \                 \ #,###,### ###.# ##,###   \       \ \                  \"; BlockCount; BType$; BL!; Secs!; SR!; PT$π              SEEK #1, s! + BL!π            CASE 3π              BL! = GetBlkLenπ              s! = SEEK(1)π              BType$ = "Silence"π              Pr$ = SPACE$(2)π              GET #1, , Pr$π              Pr = CVI(Pr$)π              SR$ = SPACE$(1)π              GET #1, , SR$π              SR! = ASC(SR$)π              SR! = INT(1000000! / (256 - SR!) + .5)π              Secs! = INT((Pr / SR!) * 10) / 10π              PRINT USING "##  \                 \ #,###,### ###.# ##,###   \       \ \                  \"; BlockCount; BType$; BL!; Secs!; SR!; "N/A"π              SEEK #1, s! + BL!π            CASE 4π              BL! = GetBlkLenπ              s! = SEEK(1)π              BType$ = "Marker"π              Pr$ = SPACE$(2)π              GET #1, , Pr$π              Pr = CVI(Pr$)π              PRINT USING "##  \                 \ #,###,### ###.# ##,###   \       \ \                  \"; BlockCount; BType$; BL!; Secs!; SR!; "N/A"; "Marker=" + LTRIM$(STR$(Pr))π              SEEK #1, s! + BL!π            CASE 5π              BL! = GetBlkLenπ              BType$ = "ASCII Text"π              s! = SEEK(1)π              Txt$ = SPACE$(BL!)π              GET #1, , Txt$π              PRINT USING "##  \                 \ #,###,### ###.# ##,###   \       \ \                  \"; BlockCount; BType$; BL!; 0; 0; "N/A"; "Text follows:"π              PRINT SPACE$(4); Txt$π              SEEK #1, s! + BL!π            CASE 6π              BL! = GetBlkLenπ              s! = SEEK(1)π              BType$ = "Repeat"π              Pr$ = SPACE$(2)π              GET #1, , Pr$π              Pr = CVI(Pr$)π              IF Pr <> &HFFFF THENπ                RP$ = "Repeat" + STR$(Pr) + " times."π              ELSEπ                RP$ = "Repeat endlessly."π              END IFπ              PRINT USING "##  \                 \ #,###,### ###.# ##,###   \       \ \                  \"; BlockCount; BType$; BL!; 0; 0; "N/A"; RP$π              SEEK #1, s! + BL!π            CASE 7π              BL! = GetBlkLenπ              s! = SEEK(1)π              BType$ = "End Repeat"π              PRINT USING "##  \                 \ #,###,### ###.# ##,###   \       \ \                  \"; BlockCount; BType$; BL!; 0; 0; "N/A"π              SEEK #1, s! + BL!π            CASE ELSEπ              BL! = GetBlkLenπ              s! = SEEK(1)π              BType$ = "UNKNOWN:" + LTRIM$(STR$(ASC(BType$)))π              SR$ = SPACE$(1)π              GET #1, , SR$π              SR! = ASC(SR$)π              SR! = INT(1000000! / (256 - SR!) + .5)π              Secs! = INT((BL! / SR!) * 10) / 10π              Pk$ = SPACE$(1)π              GET #1, , Pk$π              SELECT CASE ASC(Pk$)π                CASE 0π                  PT$ = "Raw 8-bit"π                CASE 1π                  PT$ = "4-bit"π                CASE 2π                  PT$ = "2.6 bit"π                CASE 3π                  PT$ = "2 bit"π                CASE ELSEπ                  PT$ = "Unknown!"π              END SELECTπ              PRINT USING "##  \                 \ #,###,### ###.# ##,###   \       \ \                  \"; BlockCount; BType$; BL!; Secs!; SR!; PT$π              SEEK #1, s! + BL!π          END SELECTπ          IF BType$ = CHR$(0) OR KY$ = CHR$(27) THENπ            EXIT DOπ          END IFπ        LOOPππ    END IFπ    CLOSE #1π    PRINT ""π    PRINT ""π    IF KY$ = CHR$(27) THENπ      EXIT DOπ    END IFπ    d$ = DIR$π  LOOPπELSEπ  PRINT "No files matching " + COMMAND$π  PRINT ""π  PRINT "VOC2SDS - a utility to convert .VOC files to Sample Dump Standard MIDIEx data."π  PRINT "Copyright 1993 Monte Ferguson"π  PRINT "Vers: "; Vers; ", Last Updated:"; LastUpdateπ  PRINT "Usage: VOC2SDS filespec"π  PRINT ""π  PRINT "filespec may contain wildcard characters, .VOC extension is assumed."π  PRINT "Data is written to filename.SDS. Only 8-bit RAW blocks can be converted!"π  PRINT "(and this version does only the 1st voice block)"πEND IFππFUNCTION GenPath$ (FSpec$)π  ' Parses the path out of passed file spec (FSpec$)π  p = LEN(FSpec$)π  DO WHILE p > 0π    IF INSTR("\:", MID$(FSpec$, p, 1)) > 0 THENπ      EXIT DOπ    END IFπ    p = p - 1π  LOOPπ  IF p > 0 THENπ    GenPath$ = LEFT$(FSpec$, p)π  ELSEπ    GenPath$ = ""π  END IFππEND FUNCTIONππFUNCTION GenSpec$ (FSpec$, DefExt$)πREM --------------------------------------------------------------------πREM  Given a filespec (FSpec$) and a default extension (DefExt$) try toπREM find some matching filesπREMπREMπt$ = FSpec$           ' Temp work variableππREM Let's try as-is...πIF LEN(DIR$(t$)) = 0 THENπ  ' Ok, let's add the default extention...π  IF RIGHT$(t$, 1) <> ":" THENπ    ' Keeps us from blowing up on "A:.TXT", etcπ    t$ = t$ + "." + DefExt$π  END IFπ  IF LEN(DIR$(t$)) = 0 THENπ    ' Alright, let's do *.extπ    t$ = FSpec$ + "*." + DefExt$π    IF LEN(DIR$(t$)) = 0 THENπ      ' Last try... add a directory slash AND *.extπ      t$ = FSpec$ + "\*." + DefExt$π      IF LEN(DIR$(t$)) = 0 THENπ        ' I give up!π        t$ = ""π      END IFπ    END IFπ  END IFπEND IFππGenSpec$ = t$ππEND FUNCTIONππFUNCTION GetBlkLen!π  a$ = SPACE$(3)π  GET #1, , a$π  l = ASC(a$)π  M = ASC(MID$(a$, 2))π  h = ASC(RIGHT$(a$, 1))π  GetBlkLen! = h * 256! * 256! + M * 256! + lπEND FUNCTIONππFUNCTION Hx$ (Text$)π  h$ = ""π  FOR i = 1 TO LEN(Text$)π    a = ASC(MID$(Text$, i, 1))π    d$ = HEX$(a)π    IF LEN(d$) < 2 THEN d$ = "0" + d$π    IF LEN(h$) > 0 THENπ      h$ = h$ + SPACE$(1)π    END IFπ    h$ = h$ + d$π  NEXT iπ  Hx$ = h$πEND FUNCTIONππFUNCTION M3toDec! (m3$)π  IF LEN(m3$) <> 3 THEN STOPπ  m1 = ASC(MID$(m3$, 1))π  m2! = ASC(MID$(m3$, 2)) * 128π  m3! = ASC(MID$(m3$, 3)) * 16384!π  M3toDec! = m1 + m2! + m3!πEND FUNCTIONππFUNCTION SngToM3$ (n!)π  i1 = INT(n! / 16384!)π  r! = n! - (i1 * 16384!)π  i2 = INT(r! / 128)π  i3 = r! - (i2 * 128)π  SngToM3$ = CHR$(i3) + CHR$(i2) + CHR$(i1)πEND FUNCTIONππThe ABC Programmer             ULTIMATE TEXT VIEWER           ULTIMATE,TEXT,VIEWER           Year of 1994           QB, QBasic, PDS        1041 36593    UTV.BAS     '==========================================================π' The Ultimate TEXT Viewer Programmed by William Yu (1994)π' Use within a commercial product is strictly prohibitedπ' Modify as you wish, includes a file directory listingπ'==========================================================ππDECLARE SUB HELP1 ()πDECLARE SUB HELP2 ()πDECLARE SUB HELP3 ()ππ'$DYNAMICπDEFINT A-ZππCONST FALSE = 0πCONST TRUE = NOT FALSEπFPC = FALSEπYC = 1ππCLS : LOCATE , , 0πSHELL "DIR /AD/O > Drive.LST"ππOPEN "Drive.LST" FOR INPUT AS #1πDOπ  LINE INPUT #1, CurrentDrive$πLOOP UNTIL INSTR(1, CurrentDrive$, ":\")ππCLOSE 1πKILL "DRIVE.LST"ππY = LEN(CurrentDrive$)πCurDir$ = MID$(CurrentDrive$, 15, Y)πCurDrive$ = MID$(CurrentDrive$, 15, 2)πDefaultDir$ = MID$(CurrentDrive$, 15, Y)ππEscape = FALSEπ'File$ = COMMAND$              'For QB/PDSπSTART:πCAP = FALSE: YC = 1πON ERROR GOTO ERRORHANDLEπOPEN File$ FOR INPUT AS #1πREDIM Seeks&(1 TO 16000)       'Use 32767 /ah for QB and to compile (BC)ππCurSeek& = 1πNumlines = 0πCOLOR 0, 1πFOR J = 1 TO 25πLOCATE J, 1: PRINT STRING$(80, 0)πNEXT JπCOLOR 15, 4: LOCATE 25, 1: PRINT "  The Ultimate Text Viewer Version 0.02  FREEWARE"; : COLOR 7, 4: PRINT "  <"; : COLOR 11: PRINT "1"; : COLOR 10: PRINT "2"; : COLOR 3: PRINT "3"; : COLOR 12: PRINT "4"; : COLOR 13: PRINT "5"; : COLOR 14: PRINT "6"; : COLOR 7: PRINT "7"; : COLOR 15: PRINT "8"; : COLOR 9: PRINT "9"; : COLOR 7: PRINT ">"; : COLOR 10: PRINT "  Color Change    "πCOLOR 0, 1: LOCATE 24, 1: PRINT STRING$(80, 0)πLOCATE 1, 1: COLOR 15, 3: PRINT "   F"; : COLOR 0: PRINT "ILE     "; : COLOR 15: PRINT "C"; : COLOR 0: PRINT "APTURE     "; : COLOR 15: PRINT "H"; : COLOR 0: PRINT "ELP!                                                   "ππDO UNTIL EOF(1)π  LINE INPUT #1, Text$π  Numlines = Numlines + 1π  Seeks&(Numlines) = CurSeek&          ' Save starting positionπ  CurSeek& = CurSeek& + LEN(Text$) + 2 ' Next position - 2 isπ  LOCATE 1, 60: COLOR 14, 3: PRINT Numlinesπ  V$ = INKEY$π  IF V$ = CHR$(27) THEN EXIT DOπLOOP                                     ' for C/R & LFππLOCATE 1, 1ππCurCol = 1                               ' Current ColumnπSeekEl = 1                               ' Current lineπEscape = FALSEππCOLOR 7, 1: X = 7ππDOπ  GOSUB LoadAndDisplayπ  GOSUB KeyProcessπLOOP UNTIL EscapeππCLOSEπLOCATE 25, 1: COLOR 7, 0: PRINT STRING$(80, 0): LOCATE 24, 1: COLOR 7, 0: PRINT "Thanks for Using The Ultimate Text Viewer Version 0.02  FREEWARE Copy!  (c) 1994": GOTO QUITππLoadAndDisplay:π  SEEK #1, Seeks&(SeekEl)ππ  FOR I = 2 TO 24π    IF NOT EOF(1) THEN LINE INPUT #1, Text$ ELSE Text$ = ""π    COLOR X, YCπ    Strg$ = SPACE$(80)π    IF LEN(Text$) < CurCol THEN Text$ = Text$ + SPACE$(CurCol - LEN(Text$))π    LSET Strg$ = MID$(Text$, CurCol)π    IF NOT EOF(1) AND INSTR(1, Strg$, "") THEN LINE INPUT #1, Text$: Strg$ = SPACE$(80): LSET Strg$ = MID$(Text$, CurCol)π    IF CAP = TRUE AND I = 2 THEN LOCATE I, 1, 0: COLOR 15, 4: PRINT Strg$: COLOR 7, 0: GOTO CFπ    LOCATE I, 1, 0: PRINT Strg$;πCF:πIF CAP = TRUE THEN LOCATE 1, 45: COLOR 1, 3: PRINT PS; : COLOR 0, 3: PRINT CHR$(26); : COLOR 1, 3: PRINT SeekElπ  LOCATE 1, 60: COLOR 14, 3: PRINT Numlines; : COLOR 10: PRINT ":"; : COLOR 4: PRINT SeekEl; : COLOR 10: PRINT ":"; : COLOR 15: PRINT CurColπ    COLOR X, YCπ  NEXT IπRETURNπππKeyProcess:ππ  DOπ    Ky$ = INKEY$π  LOOP UNTIL LEN(Ky$)                'Wait for a keypressππ  IF LEN(Ky$) = 1 THEN               'Create a key codeπ    KeyCode = ASC(Ky$)               'Regular character keyπ  ELSE                               'Extended keyπ    KeyCode = -ASC(RIGHT$(Ky$, 1))π  END IFππ  SELECT CASE KeyCodeπ    CASE 27π      Escape = TRUE        ' ESCππ    CASE -72             ' Up Arrowπ      SeekEl = SeekEl - 1π      IF SeekEl < 1 THEN SeekEl = 1: GOTO KeyProcessππ    CASE -80             ' Dn Arrowπ      SeekEl = SeekEl + 1π      IF SeekEl > Numlines THEN SeekEl = SeekEl - 1: GOTO KeyProcessππ    CASE -77             ' Right Arrowπ      CurCol = CurCol + 1ππ    CASE -75             ' Left Arrowπ      CurCol = CurCol - 1π      IF CurCol < 1 THEN CurCol = 1: GOTO KeyProcessππ    CASE -73           ' Page Upπ      SeekEl = SeekEl - 23π      IF SeekEl < 1 THEN SeekEl = 1ππ    CASE -81, 13, 32           ' Page Dnπ      SeekEl = SeekEl + 23π      IF SeekEl > Numlines THENπ        SeekEl = Numlines - 23: GOTO KeyProcessπ      END IFππ    CASE -71                       ' Homeπ    LOCATE 1, 70: COLOR 15, 3: PRINT "          "π      SeekEl = 1ππ    CASE -79                       ' Endπ      SeekEl = Numlines - 23π      IF SeekEl < 1 THEN SeekEl = 1: GOTO KeyProcessππ    CASE 49π      X = 11π    CASE 50π      X = 10π    CASE 51π      X = 3π    CASE 52π      X = 12π    CASE 53π      X = 13π    CASE 54π      X = 14π    CASE 55π      X = 7π    CASE 56π      X = 15π    CASE 57π      X = 9π    CASE 70π      GOSUB FKEYπ    CASE 102π      GOSUB FKEYππ    CASE 67π      GOSUB CAPTUREπ    CASE 99π      GOSUB CAPTUREππ    CASE 72π      GOSUB HELPπ    CASE 104π      GOSUB HELPππ    CASE -59π       CALL HELP2π    CASE -60π    TextFile$ = "TXT"π       GOTO LISTFILESπ    CASE -61π    TextFile$ = "*"π       GOTO LISTFILESπ    CASE -62π       FPC = TRUE: PCOPY 0, 1: GOTO PRINTERπ    CASE -63π       PCOPY 0, 1: GOSUB CAPONπ    CASE -64π       PCOPY 0, 1: GOSUB CAPOFFπ    CASE -65π       PCOPY 0, 1: GOSUB SAVECAPπ    CASE -66π       PCOPY 0, 1: GOSUB DOSSHELLππ    CASE ELSEπ      GOTO KeyProcessππ    END SELECTππRETURNππFKEY:πFPC = FALSEπPCOPY 0, 1πFOR R = 3 TO 11πLOCATE R, 4: COLOR 0, 0: PRINT STRING$(21, 0)πNEXT RπLOCATE 1, 3: COLOR 15, 4: PRINT " F"; : COLOR 10, 4: PRINT "ILE "πLOCATE 2, 2: COLOR 0, 3: PRINT "┌───────────────────┐"πLOCATE 3, 2: PRINT CHR$(179); : COLOR 15, 0: PRINT " O"; : COLOR 7, 0: PRINT "pen Text File... "; : COLOR 0, 3: PRINT CHR$(179)πLOCATE 4, 2: PRINT CHR$(179); : COLOR 15, 3: PRINT " L"; : COLOR 0: PRINT "ist All Files    "; CHR$(179)πLOCATE 5, 2: PRINT CHR$(195); STRING$(19, 196); CHR$(180)πLOCATE 6, 2: PRINT CHR$(179); : COLOR 15, 3: PRINT " P"; : COLOR 0: PRINT "rint Entire File "; CHR$(179)πLOCATE 7, 2: PRINT CHR$(179); : COLOR 15, 3: PRINT " D"; : COLOR 0: PRINT "OS Shell...      "; CHR$(179)πLOCATE 8, 2: PRINT CHR$(195); STRING$(19, 196); CHR$(180)πLOCATE 9, 2: PRINT CHR$(179); : COLOR 0, 3: PRINT " E"; : COLOR 15, 3: PRINT "x"; : COLOR 0, 3: PRINT "it              "; CHR$(179)πLOCATE 10, 2: PRINT "└───────────────────┘"πROW = 3πFKEYSEL:πV$ = INKEY$πIF UCASE$(V$) = "X" THEN LOCATE 25, 1: COLOR 7, 0: PRINT STRING$(80, 0): LOCATE 24, 1: COLOR 7, 0: PRINT "Thanks for Using The Ultimate Text Viewer Version 0.02  FREEWARE Copy!  (c) 1994": GOTO QUITπIF UCASE$(V$) = "P" THEN GOTO PRINTERπIF UCASE$(V$) = "O" THEN TextFile$ = "TXT": GOTO LISTFILESπIF UCASE$(V$) = "L" THEN TextFile$ = "*": GOTO LISTFILESπIF UCASE$(V$) = "D" THEN GOTO DOSSHELLπIF V$ = CHR$(0) + "P" THEN ROW = ROW + 1: GOSUB DOWNπIF V$ = CHR$(0) + "H" THEN ROW = ROW - 1: GOSUB UPπIF V$ = CHR$(0) + "M" THEN PCOPY 1, 0: GOTO CAPTUREπIF V$ = CHR$(0) + "K" THEN PCOPY 1, 0: GOTO HELPπIF V$ = CHR$(13) THEN GOTO ENTERπIF V$ = CHR$(0) + ";" THEN CALL HELP2     'F1πIF V$ = CHR$(0) + "<" THEN TextFile$ = "TXT": GOTO LISTFILES 'F2πIF V$ = CHR$(0) + "=" THEN TextFile$ = "*": GOTO LISTFILES'F3πIF V$ = CHR$(0) + ">" THEN GOSUB PRINTER   'F4πIF V$ = CHR$(0) + "?" THEN GOTO CAPON     'F5πIF V$ = CHR$(0) + "@" THEN GOTO CAPOFF    'F6πIF V$ = CHR$(0) + "A" THEN GOTO SAVECAP   'F7πIF V$ = CHR$(0) + "B" THEN GOTO DOSSHELL  'F8πIF V$ = CHR$(27) THEN PCOPY 1, 0: RETURNπGOTO FKEYSELπDOWN:πIF ROW = 8 THEN ROW = 3πIF ROW = 3 THEN LOCATE ROW, 3: COLOR 15, 0: PRINT " O"; : COLOR 7, 0: PRINT "pen Text File... ": LOCATE 9, 3: COLOR 0, 3: PRINT " E"; : COLOR 15, 3: PRINT "x"; : COLOR 0, 3: PRINT "it              "πIF ROW = 4 THEN LOCATE ROW, 3: COLOR 15, 0: PRINT " L"; : COLOR 7, 0: PRINT "ist All Files    ": LOCATE 3, 3: COLOR 15, 3: PRINT " O"; : COLOR 0, 3: PRINT "pen Text File... "πIF ROW = 5 THEN LOCATE 6, 3: COLOR 15, 0: PRINT " P"; : COLOR 7, 0: PRINT "rint Entire File ": LOCATE 4, 3: COLOR 15, 3: PRINT " L"; : COLOR 0, 3: PRINT "ist All Files    "πIF ROW = 6 THEN LOCATE 7, 3: COLOR 15, 0: PRINT " D"; : COLOR 7, 0: PRINT "OS Shell...      ": LOCATE 6, 3: COLOR 15, 3: PRINT " P"; : COLOR 0, 3: PRINT "rint Entire File "πIF ROW = 7 THEN LOCATE 9, 3: COLOR 7, 0: PRINT " E"; : COLOR 15, 0: PRINT "x"; : COLOR 7, 0: PRINT "it              ": LOCATE 7, 3: COLOR 15, 3: PRINT " D"; : COLOR 0, 3: PRINT "OS Shell...      "πRETURNπUP:πIF ROW = 2 THEN ROW = 7πIF ROW = 7 THEN LOCATE 3, 3: COLOR 15, 3: PRINT " O"; : COLOR 0, 3: PRINT "pen Text File... ": LOCATE 9, 3: COLOR 7, 0: PRINT " E"; : COLOR 15, 0: PRINT "x"; : COLOR 7, 0: PRINT "it              "πIF ROW = 3 THEN LOCATE 4, 3: COLOR 15, 3: PRINT " L"; : COLOR 0, 3: PRINT "ist All Files    ": LOCATE 3, 3: COLOR 15, 0: PRINT " O"; : COLOR 7, 0: PRINT "pen Text File... "πIF ROW = 4 THEN LOCATE 6, 3: COLOR 15, 3: PRINT " P"; : COLOR 0, 3: PRINT "rint Entire File ": LOCATE 4, 3: COLOR 15, 0: PRINT " L"; : COLOR 7, 0: PRINT "ist All Files    "πIF ROW = 5 THEN LOCATE 7, 3: COLOR 15, 3: PRINT " D"; : COLOR 0, 3: PRINT "OS Shell...      ": LOCATE 6, 3: COLOR 15, 0: PRINT " P"; : COLOR 7, 0: PRINT "rint Entire File "πIF ROW = 6 THEN LOCATE 9, 3: COLOR 0, 3: PRINT " E"; : COLOR 15, 3: PRINT "x"; : COLOR 0, 3: PRINT "it              ": LOCATE 7, 3: COLOR 15, 0: PRINT " D"; : COLOR 7, 0: PRINT "OS Shell...      "πRETURNπENTER:πIF ROW = 7 THEN LOCATE 25, 1: COLOR 7, 0: PRINT STRING$(80, 0): LOCATE 24, 1: COLOR 7, 0: PRINT "Thanks for Using The Ultimate Text Viewer Version 0.02  FREEWARE Copy!  (c) 1994": GOTO QUITπIF ROW = 6 THEN GOTO DOSSHELLπIF ROW = 5 THEN GOTO PRINTERπIF ROW = 4 THEN TextFile$ = "*": GOTO LISTFILESπIF ROW = 3 THEN TextFile$ = "TXT": GOTO LISTFILESππLISTFILES:πPCOPY 1, 0πSHELL "DIR /AD/O > Drive.LST"πππ'=============================π'    Current Drive / Pathπ'=============================ππDosCmd$ = "DIR *." + TextFile$ + " /B /ON > DIR.LST"πSHELL DosCmd$πLOCATE 2, 4: COLOR 12, 0: PRINT CHR$(218); STRING$(72, 196); CHR$(191)πLOCATE 3, 4: PRINT CHR$(179); STRING$(72, 0); CHR$(179)πLOCATE 4, 4: PRINT CHR$(192); STRING$(72, 196); CHR$(217)πLOCATE 3, 6: COLOR 10: PRINT CurDir$ + "\*."; TextFile$ππLOCATE 6, 10: COLOR 11: PRINT CHR$(218); STRING$(20, 196); CHR$(191)πFOR J = 7 TO 16π  LOCATE J, 10: PRINT CHR$(179); STRING$(20, 0); CHR$(179)πNEXT JπLOCATE 17, 10: PRINT CHR$(192); STRING$(20, 196); CHR$(217)πFOR J = 7 TO 18πLOCATE J, 32: COLOR 7, 8: PRINT STRING$(2, 176)πIF J = 18 THEN LOCATE J, 12: PRINT STRING$(20, 176)πNEXT JππLOCATE 6, 36: COLOR 11: PRINT CHR$(218); STRING$(12, 196); CHR$(191)πFOR J = 7 TO 16π  LOCATE J, 36: PRINT CHR$(179); STRING$(12, 0); CHR$(179)πNEXT JπLOCATE 17, 36: PRINT CHR$(192); STRING$(12, 196); CHR$(217)πFOR J = 7 TO 18πLOCATE J, 50: COLOR 7, 8: PRINT STRING$(2, 176)πIF J = 18 THEN LOCATE J, 38: PRINT STRING$(12, 176)πNEXT JππLOCATE 6, 54: COLOR 11: PRINT CHR$(218); STRING$(9, 196); CHR$(191)πFOR J = 7 TO 14π  LOCATE J, 54: PRINT CHR$(179); STRING$(9, 0); CHR$(179)πNEXT JπLOCATE 15, 54: PRINT CHR$(192); STRING$(9, 196); CHR$(217)πFOR J = 7 TO 16πLOCATE J, 65: COLOR 7, 8: PRINT STRING$(2, 176)πIF J = 16 THEN LOCATE J, 56: PRINT STRING$(9, 176)πNEXT JππLOCATE 7, 57: COLOR 7: PRINT "[-A-]"πLOCATE 8, 57: PRINT "[-B-]"πLOCATE 9, 57: PRINT "[-C-]"πLOCATE 10, 57: PRINT "[-D-]"πLOCATE 11, 57: PRINT "[-E-]"πLOCATE 12, 57: PRINT "[-F-]"πLOCATE 13, 57: PRINT "[-G-]"πLOCATE 14, 57: PRINT "[-H-]"ππTEXTPICK:πCLOSE 1π  REDIM DirNames$(100)π  I = 0πOPEN "DRIVE.LST" FOR INPUT AS #1ππ  DOπ     INPUT #1, X$π     IF INSTR(1, X$, "<DIR>") THENπ        I = I + 1π        DirNames$(I) = LEFT$(X$, 8)π     END IFπ  LOOP WHILE NOT (EOF(1))πGR = IπI = 1πJ = 7πDOπ     LOCATE J, 38: COLOR 7, 0: PRINT DirNames$(I)π     IF I = GR THEN EXIT DOπ     I = I + 1π     J = J + 1πLOOP UNTIL J = 17ππCLOSEπFOR J = 7 TO 16πCOLOR 15, 0πLOCATE J, 12: PRINT STRING$(17, 0)πNEXT JππFileNum = 0πFile = 7πI = 7πN = 1ππOPEN "DIR.LST" FOR INPUT AS #1ππDO WHILE NOT EOF(1)π  LINE INPUT #1, FileName$π  FileNum = FileNum + 1πLOOPππCLOSE 1πOPEN "DIR.LST" FOR INPUT AS #1ππDO WHILE NOT EOF(1)π     LINE INPUT #1, FileName$π     COLOR 7π     LOCATE File, 14: PRINT FileName$π     File = File + 1π     IF File = 17 THEN EXIT DOπLOOPππCLOSE 1πOPEN "DIR.LST" FOR INPUT AS #1ππ'=============================================π'          Select Text to Viewπ'=============================================ππIF EOF(1) THEN LOCATE 7, 13: COLOR 14, 0: PRINT "No File(s) Found": GOTO DIRECTORYπLINE INPUT #1, FileName$πI = 7πLOCATE I, 12: COLOR 15, 1: PRINT "  " + FileName$ + "  "ππSELECTFILE:πV$ = INKEY$πIF V$ = CHR$(0) + "P" THEN GOSUB SELDOWNπIF V$ = CHR$(0) + "H" THEN GOSUB SELUPπIF V$ = CHR$(0) + "M" THEN COLOR 7, 0: LOCATE I, 12: PRINT "  " + FileName$ + "  ": GOTO DIRECTORYπIF V$ = CHR$(13) THEN GOTO SELENTERπIF V$ = CHR$(27) THEN File$ = "": CLOSE : KILL "DRIVE.LST": KILL "DIR.LST": GOTO STARTπGOTO SELECTFILEππSELDOWN:πIF EOF(1) THEN RETURNπCOLOR 7, 0: GOSUB SELMAINπLINE INPUT #1, FileName$πN = N + 1πI = I + 1πCOLOR 15, 1πGOSUB SELMAINπRETURNππSELUP:πIF N = 1 THEN RETURNπCOLOR 7, 0: GOSUB SELMAINπCLOSE 1πOPEN "DIR.LST" FOR INPUT AS #1πNU = 1πDOπ     LINE INPUT #1, FileName$π     NU = NU + 1πLOOP UNTIL NU = NπN = N - 1: I = I - 1πCOLOR 15, 1πGOSUB SELMAINπRETURNππSELMAIN:πIF I = 17 THEN I = 16: GOSUB DISPLAYDOWNπIF I = 6 THEN I = 7: GOSUB DISPLAYUP: RETURNπIF I = 7 THEN LOCATE I, 12: PRINT "                ": LOCATE I, 12: PRINT "  " + FileName$ + "  "πIF I = 8 THEN LOCATE I, 12: PRINT "  " + FileName$ + "  "πIF I = 9 THEN LOCATE I, 12: PRINT "  " + FileName$ + "  "πIF I = 10 THEN LOCATE I, 12: PRINT "  " + FileName$ + "  "πIF I = 11 THEN LOCATE I, 12: PRINT "  " + FileName$ + "  "πIF I = 12 THEN LOCATE I, 12: PRINT "  " + FileName$ + "  "πIF I = 13 THEN LOCATE I, 12: PRINT "  " + FileName$ + "  "πIF I = 14 THEN LOCATE I, 12: PRINT "  " + FileName$ + "  "πIF I = 15 THEN LOCATE I, 12: PRINT "  " + FileName$ + "  "πIF I = 16 THEN LOCATE I, 12: PRINT "  " + FileName$ + "  "πRETURNππDISPLAYDOWN:πCLOSE 1πOPEN "DIR.LST" FOR INPUT AS #1ππNL = 10πDOπLINE INPUT #1, FileName$πNL = NL + 1πLOOP UNTIL NL = NππFOR J = 7 TO 16π  LINE INPUT #1, FileName$π    COLOR 7, 0π  LOCATE J, 14: PRINT "            "π  LOCATE J, 14: PRINT FileName$πNEXT JππCOLOR 15, 1πRETURNππDISPLAYUP:πCLOSE 1πOPEN "DIR.LST" FOR INPUT AS #1ππFOR H = 1 TO Nπ     LINE INPUT #1, FileName$πNEXT HππLOCATE 7, 14: PRINT "              "πCOLOR 15, 1πGOSUB SELMAINππFOR J = 8 TO 16π  LINE INPUT #1, FileName$π    COLOR 7, 0π  LOCATE J, 14: PRINT "            "π  LOCATE J, 14: PRINT FileName$πNEXT JππCLOSE 1πOPEN "DIR.LST" FOR INPUT AS #1ππFOR H = 1 TO Nπ     LINE INPUT #1, FileName$πNEXT HππRETURNπππSELENTER:πPCOPY 1, 0πCLOSEπKILL "DRIVE.LST"πKILL "DIR.LST"πFile$ = FileName$πGOTO STARTππ'===============================================π'             Select Directoriesπ'===============================================ππDIRECTORY:ππCLOSE 1π  REDIM DirNames$(75)π  I = 0πOPEN "DRIVE.LST" FOR INPUT AS #1ππ  DOπ     INPUT #1, X$π     IF INSTR(1, X$, "<DIR>") THENπ        I = I + 1π        DirNames$(I) = LEFT$(X$, 8)π     END IFπ  LOOP WHILE NOT (EOF(1))πGR = IπI = 1πJ = 7πDOπ     LOCATE J, 38: COLOR 7, 0: PRINT DirNames$(I)π     IF I = GR THEN EXIT DOπ     I = I + 1π     J = J + 1πLOOP UNTIL J = 17πI = 1: C = 7πLOCATE C, 38: COLOR 15, 4: PRINT DirNames$(1)ππDIRSEL:πV$ = INKEY$πIF V$ = CHR$(0) + "P" THEN GOSUB DIRDOWNπIF V$ = CHR$(0) + "H" THEN GOSUB DIRUPπIF V$ = CHR$(0) + "K" THEN GOTO TEXTPICKπIF V$ = CHR$(0) + "M" THEN GOTO DRIVEπIF V$ = CHR$(13) THEN GOTO DIRENTERπIF V$ = CHR$(27) THEN File$ = "": CLOSE : KILL "DRIVE.LST": KILL "DIR.LST": GOTO STARTπGOTO DIRSELππDIRDOWN:πIF GR = I THEN RETURNπCOLOR 7, 0πGOSUB DIRMAINπC = C + 1: I = I + 1πCOLOR 15, 4πGOSUB DIRMAINπRETURNππDIRUP:πIF I = 1 THEN RETURNπCOLOR 7, 0πGOSUB DIRMAINπC = C - 1: I = I - 1πCOLOR 15, 4πGOSUB DIRMAINπRETURNππDIRMAIN:πIF C = 17 THEN C = 16: GOSUB DIRDISDOWNπIF C = 6 THEN C = 7: GOSUB DIRDISUPπLOCATE C, 38: PRINT DirNames$(I)πRETURNππDIRDISDOWN:πI = I - 10πFOR J = 7 TO 16πI = I + 1πCOLOR 7, 0πLOCATE J, 38: PRINT DirNames$(I)πNEXT JπCOLOR 15, 4πRETURNππDIRDISUP:πI = I - 1πFOR J = 7 TO 16πI = I + 1πCOLOR 7, 0πLOCATE J, 38: PRINT DirNames$(I)πNEXT JπI = I - 9πCOLOR 15, 4πRETURNππDIRENTER:πCLOSEπKILL "DRIVE.LST"πKILL "DIR.LST"πIF LEFT$(DirNames$(I), 2) = ". " THEN DirNames$(I) = MID$(CurrentDrive$, 15, 3)πDosCmd$ = "CD " + DirNames$(I)πSHELL DosCmd$πDIRENTER2:πSHELL "DIR /AD /O> DRIVE.LST"πDosCmd$ = "DIR *." + TextFile$ + " /B /ON > DIR.LST"πSHELL DosCmd$πOPEN "Drive.LST" FOR INPUT AS #1πDOπ  LINE INPUT #1, CurrentDrive$πLOOP UNTIL INSTR(1, CurrentDrive$, ":\")πCLOSE 1ππY = LEN(CurrentDrive$)πCurDir$ = MID$(CurrentDrive$, 15, Y)πLOCATE 3, 6: COLOR 15, 0: PRINT STRING$(71, 0)πIF RIGHT$(CurDir$, 1) = "\" THENπLOCATE 3, 6: COLOR 10, 0: PRINT CurDir$ + "*." + TextFile$πELSEπLOCATE 3, 6: COLOR 10, 0: PRINT CurDir$ + "\*." + TextFile$πEND IFππFOR J = 7 TO 16πCOLOR 15, 0πLOCATE J, 37: PRINT STRING$(11, 0)πNEXT JππFOR J = 7 TO 16πCOLOR 15, 0πLOCATE J, 12: PRINT STRING$(17, 0)πNEXT JππGOTO TEXTPICKππ'==================================π'        Drive Switchingπ'==================================ππDRIVE:πCLOSE 1π  REDIM DirNames$(75)π  I = 0πOPEN "DRIVE.LST" FOR INPUT AS #1ππ  DOπ     INPUT #1, X$π     IF INSTR(1, X$, "<DIR>") THENπ        I = I + 1π        DirNames$(I) = LEFT$(X$, 8)π     END IFπ  LOOP WHILE NOT (EOF(1))πGR = IπI = 1πJ = 7πDOπ     LOCATE J, 38: COLOR 7, 0: PRINT DirNames$(I)π     IF I = GR THEN EXIT DOπ     I = I + 1π     J = J + 1πLOOP UNTIL J = 17ππCLOSEπI = 7πLOCATE I, 56: COLOR 15, 5: PRINT " [-A-] "ππDRIVESEL:πV$ = INKEY$πIF V$ = CHR$(0) + "K" THEN COLOR 7, 0: GOSUB DRIVEMAIN: GOTO DIRECTORYπIF V$ = CHR$(27) THEN File$ = "": CLOSE : KILL "DRIVE.LST": KILL "DIR.LST": GOTO STARTπIF V$ = CHR$(0) + "P" THEN GOSUB DRIVEDOWNπIF V$ = CHR$(0) + "H" THEN GOSUB DRIVEUPπIF V$ = CHR$(13) THEN GOTO DRIVEENTERπGOTO DRIVESELππDRIVEDOWN:πCOLOR 7, 0πGOSUB DRIVEMAINπI = I + 1πCOLOR 15, 5πGOSUB DRIVEMAINπRETURNππDRIVEUP:πCOLOR 7, 0πGOSUB DRIVEMAINπI = I - 1πCOLOR 15, 5πGOSUB DRIVEMAINπRETURNππDRIVEMAIN:πIF I = 15 THEN I = 7πIF I = 6 THEN I = 14πIF I = 7 THEN LOCATE I, 56: PRINT " [-A-] "πIF I = 8 THEN LOCATE I, 56: PRINT " [-B-] "πIF I = 9 THEN LOCATE I, 56: PRINT " [-C-] "πIF I = 10 THEN LOCATE I, 56: PRINT " [-D-] "πIF I = 11 THEN LOCATE I, 56: PRINT " [-E-] "πIF I = 12 THEN LOCATE I, 56: PRINT " [-F-] "πIF I = 13 THEN LOCATE I, 56: PRINT " [-G-] "πIF I = 14 THEN LOCATE I, 56: PRINT " [-H-] "πRETURNππDRIVEENTER:πCOLOR 7, 0: GOSUB DRIVEMAINπKILL "DRIVE.LST"πKILL "DIR.LST"πIF I = 7 THEN SHELL "A:"πIF I = 8 THEN SHELL "B:"πIF I = 9 THEN SHELL "C:"πIF I = 10 THEN SHELL "D:"πIF I = 11 THEN SHELL "E:"πIF I = 12 THEN SHELL "F:"πIF I = 13 THEN SHELL "G:"πIF I = 14 THEN SHELL "H:"πGOTO DIRENTER2ππ'==================================================π'           Restore Current Drive/Pathπ'==================================================ππQUIT:πCOLOR 7, 0πSHELL CurDrive$πDosCmd$ = "CD " + DefaultDir$πSHELL DosCmd$πENDπππDOSSHELL:πPCOPY 1, 0: COLOR 7, 0: CLS : SHELL "ECHO Type 'EXIT' to Return to The Ultimate Text Viewer": SHELL: PCOPY 1, 0: LOCATE 1, 1: COLOR 15, 3: PRINT "   F"; : COLOR 0: PRINT "ILE     "; : COLOR 15: PRINT "C"; : COLOR 0: PRINT "APTURE     "; : COLOR 15:                                                                          PRINT "H"; : COLOR 0: PRINT "ELP!     ": GOTO FKEYππPRINTER:πOPEN "LPT1:BIN" FOR OUTPUT AS #2πPP = SeekElπCLOSE #1πOPEN File$ FOR INPUT AS #1π     FOR Y = 10 TO 12π     LOCATE Y, 30: COLOR 0, 0: PRINT STRING$(31, 0)π     NEXT Yπ     LOCATE 9, 28: COLOR 14, 4: PRINT "┌─────────────────────────────┐"π     LOCATE 10, 28:  PRINT CHR$(179); : COLOR 15: PRINT "    Press <ESC> to Abort!    "; : COLOR 14: PRINT CHR$(179)π     LOCATE 11, 28: PRINT "└─────────────────────────────┘"πDO UNTIL EOF(1)πV$ = INKEY$πIF V$ = CHR$(27) THEN EXIT DOπLINE INPUT #1, Text$πLPRINT Text$πLOOPπCLOSEπOPEN File$ FOR INPUT AS #1πDOπLINE INPUT #1, Text$πLOOP UNTIL PP = SeekElπPNEXT:πIF FPC = TRUE THEN RETURN ELSE GOTO FKEYππCAPTURE:πPCOPY 0, 1πLOCATE 1, 12: COLOR 15, 4: PRINT " C"; : COLOR 10: PRINT "APTURE "πFOR R = 3 TO 8πLOCATE R, 13: COLOR 0, 0: PRINT STRING$(15, 0)πNEXT RπLOCATE 2, 11: COLOR 0, 3: PRINT "┌─────────────┐"πLOCATE 3, 11: PRINT CHR$(179); : COLOR 7, 0: PRINT " T"; : COLOR 7, 0: PRINT "urn  "; : COLOR 15, 0: PRINT "O"; : COLOR 7, 0: PRINT "n... "; : COLOR 0, 3: PRINT CHR$(179)πLOCATE 4, 11: PRINT CHR$(179); : COLOR 0: PRINT " Turn  O"; : COLOR 15, 3: PRINT "f"; : COLOR 0: PRINT "f   "; CHR$(179)πLOCATE 5, 11: PRINT CHR$(195); STRING$(13, 196); CHR$(180)πLOCATE 6, 11: PRINT CHR$(179); : COLOR 15, 3: PRINT " S"; : COLOR 0: PRINT "ave As...  "; CHR$(179)πLOCATE 7, 11: PRINT "└─────────────┘"πROW = 3πCAPTUREKEY:πV$ = INKEY$πIF V$ = CHR$(27) THEN PCOPY 1, 0: RETURNπIF V$ = CHR$(13) THEN GOTO CAPENTERπIF UCASE$(V$) = "O" THEN GOTO CAPONπIF UCASE$(V$) = "F" THEN GOTO CAPOFFπIF UCASE$(V$) = "S" THEN GOTO SAVECAPπIF V$ = CHR$(0) + "P" THEN ROW = ROW + 1: GOSUB CAPDOWNπIF V$ = CHR$(0) + "H" THEN ROW = ROW - 1: GOSUB CAPUPπIF V$ = CHR$(0) + "K" THEN PCOPY 1, 0: GOTO FKEYπIF V$ = CHR$(0) + "M" THEN PCOPY 1, 0: GOTO HELPπIF V$ = CHR$(0) + ";" THEN CALL HELP2     'F1πIF V$ = CHR$(0) + "<" THEN TextFile$ = "TXT": GOTO LISTFILES'F2πIF V$ = CHR$(0) + "=" THEN TextFile$ = "*": GOTO LISTFILES'F3πIF V$ = CHR$(0) + ">" THEN GOTO PRINTER   'F4πIF V$ = CHR$(0) + "?" THEN GOTO CAPON     'F5πIF V$ = CHR$(0) + "@" THEN GOTO CAPOFF    'F6πIF V$ = CHR$(0) + "A" THEN GOTO SAVECAP   'F7πIF V$ = CHR$(0) + "B" THEN GOTO DOSSHELL  'F8πGOTO CAPTUREKEYππCAPDOWN:πIF ROW = 6 THEN ROW = 3πIF ROW = 3 THEN LOCATE 3, 12: COLOR 7, 0: PRINT " Turn  "; : COLOR 15, 0: PRINT "O"; : COLOR 7, 0: PRINT "n... ": LOCATE 6, 12: COLOR 15, 3: PRINT " S"; : COLOR 0, 3: PRINT "ave As...  "πIF ROW = 4 THEN LOCATE 4, 12: COLOR 7, 0: PRINT " Turn  O"; : COLOR 15, 0: PRINT "f"; : COLOR 7, 0: PRINT "f   ": LOCATE 3, 12: COLOR 0, 3: PRINT " Turn  "; : COLOR 15, 3: PRINT "O"; : COLOR 0: PRINT "n... "πIF ROW = 5 THEN LOCATE 6, 12: COLOR 15, 0: PRINT " S"; : COLOR 7, 0: PRINT "ave As...  ": LOCATE 4, 12: COLOR 0, 3: PRINT " Turn  O"; : COLOR 15, 3: PRINT "f"; : COLOR 0, 3: PRINT "f   "πRETURNπCAPUP:πIF ROW = 2 THEN ROW = 5πIF ROW = 3 THEN LOCATE 3, 12: COLOR 7, 0: PRINT " Turn  "; : COLOR 15, 0: PRINT "O"; : COLOR 7, 0: PRINT "n... ": LOCATE 4, 12: COLOR 0, 3: PRINT " Turn  O"; : COLOR 15, 3: PRINT "f"; : COLOR 0, 3: PRINT "f   "πIF ROW = 4 THEN LOCATE 4, 12: COLOR 7, 0: PRINT " Turn  O"; : COLOR 15, 0: PRINT "f"; : COLOR 7, 0: PRINT "f   ": LOCATE 6, 12: COLOR 15, 3: PRINT " S"; : COLOR 0, 3: PRINT "ave As...  "πIF ROW = 5 THEN LOCATE 6, 12: COLOR 15, 0: PRINT " S"; : COLOR 7, 0: PRINT "ave As...  ": LOCATE 3, 12: COLOR 0, 3: PRINT " Turn  "; : COLOR 15, 3: PRINT "O"; : COLOR 0, 3: PRINT "n... "πRETURNππCAPENTER:πIF ROW = 3 THEN GOTO CAPONπIF ROW = 4 THEN GOTO CAPOFFπIF ROW = 5 THEN GOTO SAVECAPππCAPON:πPS = SeekElπPCOPY 1, 0πLOCATE 1, 36: COLOR 10, 3: PRINT "Capture:"; : COLOR 1: PRINT PS; : COLOR 0, 3: PRINT CHR$(26); SeekElπCAP = TRUEπRETURNππCAPOFF:πPCOPY 1, 0πLOCATE 1, 36: COLOR 3, 3: PRINT "                        "πCAP = FALSEπRETURNππSAVECAP:πIF CAP = FALSE THEN PCOPY 1, 0: RETURNπIF PS > SeekEl THEN PCOPY 1, 0: RETURNπCLOSE #1πOPEN File$ FOR INPUT AS #1πPS2 = PSπDOπIF PS = 1 THEN EXIT DOπLINE INPUT #1, SAVEDTEXT$πPS = PS - 1πLOOP UNTIL PS = 1πFOR V = 11 TO 13πLOCATE V, 4: COLOR 0, 0: PRINT STRING$(76, 0)πNEXT VπCOLOR 10, 2πLOCATE 10, 2: PRINT "┌"; STRING$(74, 196); "┐"πLOCATE 11, 2: PRINT CHR$(179); STRING$(74, 0); CHR$(179)πLOCATE 12, 2: PRINT "└"; STRING$(74, 196); "┘"πLOCATE 11, 4: COLOR 14, 2: PRINT "Save As: "; : COLOR 15, 2: LINE INPUT ""; FILNAM$πIF FILNAM$ = "" THEN PCOPY 1, 0: PS = PS2: RETURNπOPEN FILNAM$ FOR APPEND AS #2πPS2 = PS2 - 1π     FOR Y = 10 TO 12π     LOCATE Y, 30: COLOR 7, 8: PRINT STRING$(31, 176)π     NEXT Yπ     LOCATE 9, 28: COLOR 14, 4: PRINT "┌─────────────────────────────┐"π     LOCATE 10, 28:  PRINT CHR$(179); : COLOR 15: PRINT "     Press <ESC> to STOP!    "; : COLOR 14: PRINT CHR$(179)π     LOCATE 11, 28: PRINT "└─────────────────────────────┘"πDOπIF EOF(1) THEN EXIT DOπV$ = INKEY$πIF V$ = CHR$(27) THEN EXIT DOπLINE INPUT #1, SAVEDTEXT$πPRINT #2, SAVEDTEXT$πPS2 = PS2 + 1πLOOP UNTIL PS2 = SeekElπPS = PS2πCLOSE #2πPCOPY 1, 0πRETURNππHELP:πPCOPY 0, 1πLOCATE 1, 24: COLOR 15, 4: PRINT " H"; : COLOR 10: PRINT "ELP! "πFOR V = 3 TO 8πLOCATE V, 25: COLOR 0, 0: PRINT STRING$(18, 0)πNEXT VπLOCATE 2, 23: COLOR 0, 3: PRINT "┌────────────────┐"πLOCATE 3, 23: PRINT CHR$(179); : COLOR 15, 0: PRINT " G"; : COLOR 7, 0: PRINT "eneral Help   "; : COLOR 0, 3: PRINT CHR$(179)πLOCATE 4, 23: PRINT CHR$(179); : COLOR 15, 3: PRINT " C"; : COLOR 0: PRINT "ommand Keys   "; CHR$(179)πLOCATE 5, 23: PRINT CHR$(195); STRING$(16, 196); CHR$(180)πLOCATE 6, 23: PRINT CHR$(179); : COLOR 0, 3: PRINT " Capturing "; : COLOR 15, 3: PRINT "T"; : COLOR 0, 3: PRINT "ext "; CHR$(179)πLOCATE 7, 23: PRINT "└────────────────┘"πROW = 3πHELPKEY:πV$ = INKEY$πIF V$ = CHR$(27) THEN PCOPY 1, 0: RETURNπIF V$ = CHR$(0) + "P" THEN ROW = ROW + 1: GOSUB HELPDOWNπIF V$ = CHR$(0) + "H" THEN ROW = ROW - 1: GOSUB HELPUPπIF V$ = CHR$(0) + "M" THEN PCOPY 1, 0: GOTO FKEYπIF V$ = CHR$(0) + "K" THEN PCOPY 1, 0: GOTO CAPTUREπIF UCASE$(V$) = "G" THEN CALL HELP1πIF UCASE$(V$) = "C" THEN CALL HELP2πIF UCASE$(V$) = "T" THEN CALL HELP3πIF V$ = CHR$(13) THEN GOSUB HELPENTERπIF V$ = CHR$(0) + ";" THEN CALL HELP2     'F1πIF V$ = CHR$(0) + "<" THEN TextFile$ = "TXT": GOTO LISTFILES'F2πIF V$ = CHR$(0) + "=" THEN TextFile$ = "*": GOTO LISTFILES'F3πIF V$ = CHR$(0) + ">" THEN GOTO PRINTER   'F4πIF V$ = CHR$(0) + "?" THEN GOTO CAPON     'F5πIF V$ = CHR$(0) + "@" THEN GOTO CAPOFF    'F6πIF V$ = CHR$(0) + "A" THEN GOTO SAVECAP   'F7πIF V$ = CHR$(0) + "B" THEN GOTO DOSSHELL  'F8πGOTO HELPKEYππHELPDOWN:πIF ROW = 6 THEN ROW = 3πIF ROW = 3 THEN LOCATE 3, 24: COLOR 15, 0: PRINT " G"; : COLOR 7, 0: PRINT "eneral Help   ": LOCATE 6, 24: COLOR 0, 3: PRINT " Capturing "; : COLOR 15, 3: PRINT "T"; : COLOR 0, 3: PRINT "ext "πIF ROW = 4 THEN LOCATE 4, 24: COLOR 15, 0: PRINT " C"; : COLOR 7, 0: PRINT "ommand Keys   ": LOCATE 3, 24: COLOR 15, 3: PRINT " G"; : COLOR 0, 3: PRINT "eneral Help   "πIF ROW = 5 THEN LOCATE 6, 24: COLOR 7, 0: PRINT " Capturing "; : COLOR 15, 0: PRINT "T"; : COLOR 7, 0: PRINT "ext ": LOCATE 4, 24: COLOR 15, 3: PRINT " C"; : COLOR 0, 3: PRINT "ommand Keys   "πRETURNπHELPUP:πIF ROW = 2 THEN ROW = 5πIF ROW = 3 THEN LOCATE 3, 24: COLOR 15, 0: PRINT " G"; : COLOR 7, 0: PRINT "eneral Help   ": LOCATE 4, 24: COLOR 15, 3: PRINT " C"; : COLOR 0, 3: PRINT "ommand Keys   "πIF ROW = 4 THEN LOCATE 4, 24: COLOR 15, 0: PRINT " C"; : COLOR 7, 0: PRINT "ommand Keys   ": LOCATE 6, 24: COLOR 0, 3: PRINT " Capturing "; : COLOR 15, 3: PRINT "T"; : COLOR 0, 3: PRINT "ext "πIF ROW = 5 THEN LOCATE 6, 24: COLOR 7, 0: PRINT " Capturing "; : COLOR 15, 0: PRINT "T"; : COLOR 7, 0: PRINT "ext ": LOCATE 3, 24: COLOR 15, 3: PRINT " G"; : COLOR 0, 3: PRINT "eneral Help   "πRETURNππHELPENTER:πIF ROW = 3 THEN CALL HELP1πIF ROW = 4 THEN CALL HELP2πIF ROW = 5 THEN CALL HELP3πRETURNππERRORHANDLE:π     IF ERR = 53 OR ERR = 52 THENπCOLOR 0, 1πFOR O = 1 TO 25πLOCATE O, 1: PRINT STRING$(80, 0)πNEXT OπCOLOR 15, 4: LOCATE 25, 1: PRINT "  The Ultimate Text Viewer Version 0.02  FREEWARE"; : COLOR 7, 4: PRINT "  <"; : COLOR 11: PRINT "1"; : COLOR 10: PRINT "2"; : COLOR 3: PRINT "3"; : COLOR 12: PRINT "4"; : COLOR 13: PRINT "5"; : COLOR 14: PRINT "6"; : COLOR 7: PRINT "7"; : COLOR 15: PRINT "8"; : COLOR 9: PRINT "9"; : COLOR 7: PRINT ">"; : COLOR 10: PRINT "  Color Change    "πCOLOR 0, 1: LOCATE 24, 1: PRINT STRING$(80, 0)πLOCATE 1, 1: COLOR 15, 3: PRINT "   F"; : COLOR 0: PRINT "ILE     "; : COLOR 15: PRINT "C"; : COLOR 0: PRINT "APTURE     "; : COLOR 15: PRINT "H"; : COLOR 0: PRINT "ELP!                                                   "πLOCATE 4, 1: COLOR 7, 1πPRINT "      ▒██  ▒██ ▒██      ▒████████ ▒██ ▒███████ ▒███████ ▒████████ ▒███████"πPRINT "      ▒██  ▒██ ▒██         ▒██    ▒██ ▒██▒█▒██ ▒██  ▒██    ▒██    ▒██"πPRINT "      ▒██  ▒██ ▒██         ▒██    ▒██ ▒██  ▒██ ▒███████    ▒██    ▒██████"πPRINT "      ▒██  ▒██ ▒██         ▒██    ▒██ ▒██  ▒██ ▒██  ▒██    ▒██    ▒██"πPRINT "      ▒███████ ▒███████    ▒██    ▒██ ▒██  ▒██ ▒██  ▒██    ▒██    ▒███████"πPRINT "                                           "πPRINT "                     ▒████████ ▒███████ ▒██  ▒██ ▒████████"πPRINT "                        ▒██    ▒██      ▒██  ▒██    ▒██"πPRINT "                        ▒██    ▒██████    ▒███      ▒██"πPRINT "                        ▒██    ▒██      ▒██  ▒██    ▒██"πPRINT "                        ▒██    ▒███████ ▒██  ▒██    ▒██"πPRINTπPRINT "                ▒██  ▒██ ▒██ ▒███████ ▒██  ▒██ ▒███████ ▒███████"πPRINT "                ▒██  ▒██ ▒██ ▒██      ▒██  ▒██ ▒██      ▒██  ▒██"πPRINT "                ▒██  ▒██ ▒██ ▒██████  ▒██  ▒██ ▒██████  ▒███████"πPRINT "                ▒██  ▒██ ▒██ ▒██      ▒██▒█▒██ ▒██      ▒██ ▒██"πPRINT "                 ▒█████  ▒██ ▒███████ ▒███████ ▒███████ ▒██ ▒███"πPRINTπPRINT "              Programmed by William Yu  (c) 1994   UTV Version 0.02"πRESUME FKEYπEND IFπ     IF ERR = 25 THENπ     LOCATE 10, 20π     FOR Y = 10 TO 13π     LOCATE Y, 30: COLOR 0, 0: PRINT STRING$(31, 0)π     NEXT Yπ     LOCATE 9, 28: COLOR 14, 4: PRINT "┌─────────────────────────────┐"π     LOCATE 10, 28:  PRINT CHR$(179); : COLOR 15: PRINT "  No Printer Port Detected!  "; : COLOR 14: PRINT CHR$(179)π     LOCATE 11, 28: PRINT CHR$(179); : COLOR 15: PRINT " PLEASE TURN YOUR PRINTER ON "; : COLOR 14: PRINT CHR$(179)π     LOCATE 12, 28: PRINT "└─────────────────────────────┘"π     WHILE INKEY$ = "": WEND: PCOPY 1, 0π     LOCATE 1, 1: COLOR 15, 3: PRINT "   F"; : COLOR 0: PRINT "ILE     "π     RESUME PNEXTπ     END IFπPCOPY 1, 0πRESUME FKEYππREM $STATICπSUB HELP1πPCOPY 0, 2πLOCATE 3, 3: COLOR 10, 2: PRINT CHR$(218); STRING$(72, 196); CHR$(191)πFOR O = 4 TO 21πLOCATE O, 3: COLOR 10, 2: PRINT CHR$(179); STRING$(72, 0); CHR$(179)πNEXT OπLOCATE 22, 3: PRINT CHR$(192); STRING$(72, 196); CHR$(217)πCOLOR 7, 8: LOCATE 23, 5: PRINT STRING$(74, 176)πFOR O = 4 TO 22πLOCATE O, 77: PRINT STRING$(2, 176)πNEXT OπLOCATE 3, 34: COLOR 15, 2: PRINT "GENERAL HELP"πLOCATE 4, 5: COLOR 0, 2: PRINT "Starting up The Ultimate Text Viewer with command line:"πLOCATE 5, 8: COLOR 15, 2: PRINT "UTV <[Drive:Path]FileName.Ext>  Example:  "; : COLOR 14: PRINT "UTV UTV.TXT"πLOCATE 6, 5: COLOR 0: PRINT "Starting up The Ultimate Text Viewer Without the Command Line:"πLOCATE 7, 8: COLOR 15: PRINT "If you happen to run the program without a command line you will be"πLOCATE 8, 8: PRINT "able to select a file using the FILE command and selecting"πLOCATE 9, 10: COLOR 14: PRINT "Open a Text File  "; : COLOR 10: PRINT "(*.TXT will be displayed)"πLOCATE 10, 10: COLOR 14: PRINT "List all Files    "; : COLOR 10: PRINT "(*.* in current directory will be displayed)"πLOCATE 11, 5: COLOR 0: PRINT "Error Control:"πLOCATE 12, 8: COLOR 15: PRINT "When selecting a file, there are many  different drives from which"πLOCATE 13, 8: PRINT "you can choose from, please don't select a drive you know does not"πLOCATE 14, 8: PRINT "function or don't have."πLOCATE 21, 28: COLOR 11: PRINT "Press any key to continue..."πWHILE INKEY$ = "": WENDπPCOPY 2, 0πEND SUBππSUB HELP2πPCOPY 0, 2πLOCATE 3, 3: COLOR 10, 2: PRINT CHR$(218); STRING$(72, 196); CHR$(191)πFOR O = 4 TO 21πLOCATE O, 3: COLOR 10, 2: PRINT CHR$(179); STRING$(72, 0); CHR$(179)πNEXT OπLOCATE 22, 3: PRINT CHR$(192); STRING$(72, 196); CHR$(217)πCOLOR 7, 8: LOCATE 23, 5: PRINT STRING$(74, 176)πFOR O = 4 TO 22πLOCATE O, 77: PRINT STRING$(2, 176)πNEXT OπLOCATE 3, 27: COLOR 15, 2: PRINT "COMMAND KEYS/SHORT CUT KEYS"πLOCATE 4, 5: COLOR 0: PRINT "Scrolling Text & Menu Commands:"πLOCATE 5, 8: COLOR 15: PRINT CHR$(24); CHR$(25); : COLOR 14: PRINT " Up/Down "; : COLOR 15: PRINT CHR$(27); CHR$(26); : COLOR 14: PRINT " Left/Right "; : COLOR 15: PRINT " PGDN/PGDN "; : COLOR 14: PRINT "Up a Page/Down a Page"; : COLOR 15: PRINT " ESC"; : COLOR 14: PRINT " Exits"πLOCATE 6, 8: COLOR 15: PRINT "F"; : COLOR 14: PRINT " - FILE COMMAND"; : COLOR 11: PRINT " Open New Text File for Viewing/Printing/DOS Shell"πLOCATE 7, 8: COLOR 15: PRINT "C"; : COLOR 14: PRINT " - CAPTURE TEXT"; : COLOR 11: PRINT " Capture Certain Lines of text and saving it as..."πLOCATE 8, 8: COLOR 15: PRINT "H"; : COLOR 14: PRINT " - HELP ON UTV "; : COLOR 11: PRINT " This screen right here"πLOCATE 9, 8: COLOR 15: PRINT "1 to 9 produces a color change to the current TEXT"πLOCATE 10, 8: COLOR 11: PRINT "1 = Light Cyan  2 = Green  3 = Cyan  4 = Red  5 = Magenta 6 = Yellow"πLOCATE 11, 8: PRINT "7 = Grey (Default Color)  8 = White  9 = Blue"πLOCATE 12, 5: COLOR 0: PRINT "Short Cut Keys:"πLOCATE 13, 8: COLOR 15: PRINT "F1 "; : COLOR 14: PRINT "= Displays all the Command Keys (This Help Screen)"πLOCATE 14, 8: COLOR 15: PRINT "F2 "; : COLOR 14: PRINT "= Open a Text File"πLOCATE 15, 8: COLOR 15: PRINT "F3 "; : COLOR 14: PRINT "= List All Files"πLOCATE 16, 8: COLOR 15: PRINT "F4 "; : COLOR 14: PRINT "= Print Entire Text"πLOCATE 17, 8: COLOR 15: PRINT "F5 "; : COLOR 14: PRINT "= Turn Capture ON"πLOCATE 18, 8: COLOR 15: PRINT "F6 "; : COLOR 14: PRINT "= Turn Capture OFF"πLOCATE 19, 8: COLOR 15: PRINT "F7 "; : COLOR 14: PRINT "= Save Captured Text As..."πLOCATE 20, 8: COLOR 15: PRINT "F8 "; : COLOR 14: PRINT "= DOS Shell"πLOCATE 21, 27: COLOR 4, 2: PRINT "Press any key to continue..."πWHILE INKEY$ = "": WENDπPCOPY 2, 0πEND SUBππSUB HELP3πPCOPY 0, 2πLOCATE 3, 3: COLOR 10, 2: PRINT CHR$(218); STRING$(72, 196); CHR$(191)πFOR O = 4 TO 21πLOCATE O, 3: COLOR 10, 2: PRINT CHR$(179); STRING$(72, 0); CHR$(179)πNEXT OπLOCATE 22, 3: PRINT CHR$(192); STRING$(72, 196); CHR$(217)πCOLOR 7, 8: LOCATE 23, 5: PRINT STRING$(74, 176)πFOR O = 4 TO 22πLOCATE O, 77: PRINT STRING$(2, 176)πNEXT OπLOCATE 3, 32: COLOR 15, 2: PRINT "CAPTURING TEXT"πLOCATE 4, 5: COLOR 0: PRINT "Commands for Capturing Text:"πLOCATE 5, 8: COLOR 15: PRINT "Capturing Text is quite simple, F5 to turn capture ON or you could"πLOCATE 6, 8: PRINT "type 'C' and select Turn On"πLOCATE 7, 8: PRINT "After you have turned Capture ON, a red line should appear below the"πLOCATE 8, 8: PRINT "menu commands.  That is the first line that will be captured."πLOCATE 9, 8: PRINT "You will see a"; : COLOR 14: PRINT " Capturing 10 "; CHR$(26); " 10"; : COLOR 15: PRINT " on the top line.  (Example only)"πLOCATE 10, 8: COLOR 11: PRINT "First line to be captured"; : COLOR 12: PRINT CHR$(24); CHR$(24); "   "; CHR$(24); CHR$(24); : COLOR 11: PRINT "this is the last line to be captured"πLOCATE 11, 8: COLOR 15: PRINT "Scroll down to capture the desired amount of lines."πLOCATE 12, 8: COLOR 14: PRINT "*** Each time a line is scrolled past the red line, it is captured."πLOCATE 13, 8: COLOR 15: PRINT "You may turn Capture off anytime by pressing F6 or selecting it from"πLOCATE 14, 8: PRINT "the CAPTURE Commands.  You should SAVE your Captured Text before you"πLOCATE 15, 8: PRINT "do that by pressing F7 or selecting SAVE AS from the CAPTURE Command"πLOCATE 16, 5: COLOR 0: PRINT "Error Control:"πLOCATE 17, 8: COLOR 15: PRINT "Capture 100 "; CHR$(26); " 20 will NOT save, the first number has to be lower."πLOCATE 18, 8: PRINT "When you save the captured text as a filename that already exists,"πLOCATE 19, 8: PRINT "it will APPEND (Add the captured text) 'til end of file."πLOCATE 21, 27: COLOR 11: PRINT "Press any key to continue..."πWHILE INKEY$ = "": WENDπPCOPY 2, 0πEND SUBππThe ABC Programmer             SIMPLE BANNER SCROLL           Used within the ABC Reader     09-05-95 (16:43)       QB, QBasic, PDS        61   1569     BANNER.BAS  ' Simple Banner Scroll by William Yu 09-05-1995π' Scrolls a line of text from right to leftππDEFINT A-ZπDECLARE SUB Delay (Seconds!)πDECLARE SUB BannerScroll (Text$, ForeColor, BackColor, BeginCol, EndCol, Row)ππCLSππ' Make sure you add a trailing space at the end of TEXT$ππText$ = "Hello, my name is William Yu, and I'm The ABC Programmer. "πForeColor = 15πBackColor = 0πBeginCol = 70πEndCol = 20πRow = 25ππBannerScroll Text$, ForeColor, BackColor, BeginCol, EndCol, RowππSUB BannerScroll (Text$, ForeColor, BackColor, BeginCol, EndCol, Row)ππ' Since this is a banner scroll, the starting point is always the highestπ' If not then we exit the subroutineππIF EndCol >= BeginCol THEN EXIT SUBππDEF SEG = &HB800       ' You must have a Color Monitor to use POKEππY = 0πFOR X = BeginCol TO EndCol STEP -1π    Y = Y + 1π    LOCATE Row, X: COLOR ForeColor, BackColor: PRINT LEFT$(Text$, Y);π' If you like, you can have multiple colorsπ' To do this you POKE the color attribute to anything you wantπ' Here's an example, you'll have to modify it to suit your banner methodπ    POKE 3977, 7π    POKE 3979, 8π' Another way is to use random colors or define colors in an array.π    Delay .1πNEXT XπY = 1πH = BeginCol - EndCol + 1πE = LEN(Text$)πDOπ  Y = Y + 1π  LOCATE Row, EndCol: COLOR ForeColor, BackColor: PRINT MID$(Text$, Y, H);π  Delay .1πLOOP UNTIL Y = EππEND SUBππDEFSNG A-ZπSUB Delay (Seconds)π  Time = TIMERπ  XDELAY = Time + Secondsπ  WHILE NOT (TIMER > XDELAY)π  WENDπ  IF INKEY$ <> "" THEN ENDπEND SUBππThe ABC Programmer             EMULATES TYPING BLUNDERS       EMULATE,TYPING,BLUNDERS        Year of 1994           QB, QBasic, PDS        50   1072     BLUNDERS.BAS'==================================================π'  BLUNDERS.BAS by William Yu  (1994)π'  Emulates a simple typing blunder and correctsπ'  the spelling.π'  This works for single letters.π'==================================================ππDEFINT A-ZππCONST False = 0πCONST True = NOT FalseππCLSπText$ = "^yYou ^nknow this is a ^nbad reput^eation for this ^Sschool don^;'t you^>?"πWholeWord$ = "|These This program |is was written for |bluder blunders."πLOCATE , , 1πI = 0: X = 1πBlunder = FalseππDOπ  I = I + 1π  IF Blunder THENπ    I = I - 1π    X = X - 1π    T! = TIMERπ    DO WHILE TIMER - T! <= .1π    LOOPπ    LOCATE , X: PRINT " ";π    LOCATE , Xπ    T! = TIMERπ    DO WHILE TIMER - T! <= .1π    LOOPπ    Blunder = Falseπ    I = I + 2π  END IFπ  LOCATE , Xπ  IF MID$(Text$, I, 1) = "^" THENπ    PRINT MID$(Text$, I + 1, 1);π    Blunder = Trueπ    X = X + 1π  ELSEπ    PRINT MID$(Text$, I, 1);π    Blunder = Falseπ    X = X + 1π  END IFπ  T! = TIMERπ  DO WHILE TIMER - T! <= .07π  LOOPπLOOP UNTIL I = LEN(Text$)ππKenneth W. Melvin              SCREEN DRAWING ROUTINES        [e-mail]           10-09-95 (00:00)       QB, QBasic, VB         81   2935     DEMOSCRN.BAS'Filename:  DEMOSCRN.BASπ'Date:      10-9-1995 kwmπ'For:       QBasic, QuickBASIC, VBDOSπ'Purpose:   Demonstration of drawing screens and passing parametersπ'            to SUBprocedures. An example of structured programming.ππDECLARE SUB Shadows (UpRow%, LeftCol%, BotRow%, RtCol%)πDECLARE SUB DrawBorder (UpRow%, LeftCol%, BotRow%, RtCol%)πDECLARE SUB Background ()πDECLARE SUB ClearScrn (UpRow%, LeftCol%, BotRow%, RtCol%)ππDEFINT A-Z                              'defines variables of type integerπCLS                                     'clear the screenππUpRow = 4                               'change any of these coordinatesπLeftCol = 15                            'at this one location, and theπBotRow = 15                             'size of the window, the border,πRtCol = 65                              'and shadows change automatically.ππBackground                                      'draws a background      πCALL ClearScrn(UpRow, LeftCol, BotRow, RtCol)   'clears a blank areaπCALL DrawBorder(UpRow, LeftCol, BotRow, RtCol)  'draws a border in blank areaπCALL Shadows(UpRow, LeftCol, BotRow, RtCol)     'draws shadows under windowππCOLOR 0, 3                              'black FG, cyan BGπLOCATE UpRow + 3, LeftCol + 16          'position text in windowπPRINT "This is DEMOSCRN.BAS"            'messageπCOLOR 0, 7                              'white FG, black BGππENDππSUB Backgroundπ    COLOR 0, 7π    FOR i = 1 TO 80π        FOR j = 1 TO 25π            PRINT CHR$(176);π        NEXTπ    NEXTπEND SUBππSUB ClearScrn (UpRow, LeftCol, BotRow, RtCol)π    COLOR 0, 7π    LOCATE UpRow, LeftColπ    FOR i = UpRow TO BotRowπ        LOCATE i, LeftColπ        PRINT STRING$(RtCol - LeftCol + 1, CHR$(219))π    NEXTπEND SUBππSUB DrawBorder (UpRow, LeftCol, BotRow, RtCol)π   π    COLOR 0, 3      'change border color by changing FG [COLOR FG, BG] (0-15)π                    'change box color by changing BG (0-7 only)π                    '0=black 1=blue 2=green 3=cyan 4=red 5=magenta 6=brownπ                    '7=white 8=gray 9=hiBlue 10=hiGreen 11=hiCyan 12=hiRedπ                    '13=hiMagenta 14=Yellow 15=hiWhiteπ   π    LOCATE UpRow, LeftColπ    PRINT CHR$(213) + STRING$(((RtCol - LeftCol) - 1), CHR$(205)) + CHR$(184)π   π    FOR i = (UpRow + 1) TO (BotRow - 1)π      LOCATE i, LeftColπ      PRINT CHR$(179) + STRING$(((RtCol - LeftCol) - 1), CHR$(32)) + CHR$(179)π    NEXTπ   π    LOCATE BotRow, LeftColπ    PRINT CHR$(212) + STRING$(((RtCol - LeftCol) - 1), CHR$(205)) + CHR$(190)ππEND SUBππSUB Shadows (UpRow, LeftCol, BotRow, RtCol)π    COLOR 8, 0              'color of shadowπ    'horizontal shadow at bottomπ    LOCATE BotRow + 1, LeftCol + 2π    PRINT STRING$((RtCol - LeftCol), CHR$(178))π    'vertical shadow at right sideπ    FOR i = UpRow + 1 TO BotRowπ        LOCATE i, RtCol + 1: PRINT CHR$(178)π    NEXTπEND SUBππJesu's Lozano                  CONCATENATES ASCII TEXT        comp.lang.basic.misc           Unknown Date           QB, QBasic, PDS        49   1383     JOINT.BAS   Delim$ = " ,;()?" + CHR$(9) + CHR$(34)πcade$ = LTRIM$(RTRIM$(COMMAND$))πIF MID$(cade$, 2, 1) = " " THENπ        SELECT CASE LEFT$(cade$, 1)π        CASE "S", "s": mete$ = CHR$(32)π        CASE "T", "t": mete$ = CHR$(9)π        CASE ELSE:  mete$ = LEFT$(cade$, 1)π        END SELECTπ        cade$ = RIGHT$(cade$, LEN(cade$) - 2)πEND IFπlargo = LEN(cade$)πDIM token$(largo)πIF INSTR(cade$, ".") = 0 OR largo < 5 THENπ        PRINT "[ Concatenate ascii text or data files horizontally, line by line ]"π        PRINT "Price: 0 Registration: OFF Bugs: ON Author: [e-mail]"π        PRINT "Usage: joint [S,T] file1 file2 [...file68] >out (Space;Tab;file>?.)"πELSEπ        FOR z = 1 TO largoπ                char$ = MID$(cade$, z, 1)π                IF char$ = ">" OR char$ = "<" THEN EXIT FORπ                IF INSTR(Delim$, char$) <> 0 THENπ                        flag = 0π                ELSEπ                        IF flag = 0 THEN i = i + 1π                        flag = 1: token$(i) = token$(i) + char$π                END IFπ        NEXT zπ        FOR k = 1 TO iπ                OPEN token$(k) FOR INPUT AS #kπ        NEXT kπ        DOπ                linea$ = "": kount = 0π                FOR k = 1 TO iπ                        temp$ = ""π                        IF LEN(token$(k)) > 1 THEN LINE INPUT #k, temp$π                        linea$ = linea$ + mete$ + temp$π                NEXT kπ                PRINT linea$π                FOR k = 1 TO iπ                        IF EOF(k) <> 0 THENπ                                token$(k) = "": kount = kount + 1π                        END IFπ                NEXT kπ        LOOP UNTIL kount >= iπEND IFπFOR i = -2 TO 5π        SOUND 440 * (2 ^ (i - 10 / 12)), .6πNEXT iπENDπJesu's Lozano                  COMMATOR                       comp.lang.basic.misc           Unknown Date           QB, QBasic, PDS        115  3909     COMMATOR.BAS'    This is a another util (like JOINT.BAS) to solve 'little π'problems' reading sequential ascii data coming from/to non PC π'machines or from spreadsheets.π'    I.e. tipically a spreadsheet print ascii data in strange π'format, dificulting reading and proccesing. More than 255 chars π'per line were printed asπ'        1111111111111111π'        2222222222222222π'        111π'        222π'    When you want 11111111111111π'              111π'              22222222222222π'              222π'    Well, just cut the full lines to many files, the rest to π'another and use the joint.bas code to concatenate by lines...π    π'    BUT what about the space formats which difficults reading π'plain text data as we like? π'    i.e. Gijon 5170968 Trabajo 5182188 (not correctly readed)π'    vs.  Gijon,5170968,Trabajo,5182188 (ok to read) π     π'    Bla, bla... here is the PDS code  :-)πππ   F1$ = ";": F2$ = "<": F3$ = "=": F4$ = ">": F5$ = "?"π   F6$ = "@": F7$ = "A": F8$ = "B": F9$ = "C": F10$ = "D"π   CR$ = CHR$(13): BS$ = CHR$(8): ESC$ = CHR$(27)π   aleft$ = "K": ARIGHT$ = "M": ADOWN$ = "P": AUP$ = "H"π   AHOME$ = "G": AEND$ = "O": PGUP$ = "I": PGDN$ = "Q"πREM ----------------------------------------------------πPRINT "[ COMMATOR = Insert a lot of commas in your data files ,TA-CHAAN!,]"πPRINT "Limited to 10,000 lines. Plea, support bad programmers: Report bugs"πPRINT "Price: 0 Registration: OFF Bugs: ON Author: [e-mail]"πINPUT "  My file is pathnamed as: ", infil$πINPUT "  and want to store commated file in: ", oufil$πOPEN LTRIM$(RTRIM$(infil$)) FOR INPUT AS #1πPRINTπPRINT "Well. Now we need to show a line to serve as pattern to put some commas."πPRINT "Press arrow keys to view lines and RETURN to accept the best one. %-)   "πDIM jumpi(1 TO 10000) AS LONGπ        inilin = CSRLIN: n = 1π        DOπ                IF EOF(1) THENπ                        n = n - 1π                        SOUND 800, .2π                        SEEK #1, jumpi(n)π                END IFπ                LINE INPUT #1, linea$π                lenlinea = LEN(linea$)π                jumpi(n) = SEEK(1) - lenlinea - 2π                LOCATE inilin, 1: COLOR 0, 7: PRINT LEFT$(linea$, 78);π                IF lenlinea < 78 THEN PRINT SPACE$(78 - lenlinea);π                GOSUB esperateclaπIF (scant$ = PGUP$ OR scant$ = AHOME$ OR scant$ = AUP$ OR sacnt$ = aleft$) THENπ                IF n > 1 THEN n = n - 1π                SEEK #1, jumpi(n)πELSEπ                n = n + 1πEND IFπ        LOOP UNTIL tecla$ = CR$πCOLOR 7, 0: PRINT : PRINTπPRINT "Good. Now we have a petrified line. Let's overwrite over it some commas."πPRINT "Arrows, charts... Press SPACE to blank or RETURN to accept make the file"π        inilin = CSRLIN: i = 1π        DIM comma(lenlinea) AS INTEGERπ        DOπ                LOCATE inilin, 1: COLOR 7, 0: PRINT MID$(linea$, i, 79);π                IF lenlinea < 79 THEN PRINT SPACE$(79 - lenlinea);π                LOCATE inilin, 1: COLOR 0, 7: PRINT MID$(linea$, i, 1);π                GOSUB esperateclaπ                SELECT CASE scant$π                CASE AHOME$: i = 1π                CASE aleft$: i = i - 1π                CASE ARIGHT$: i = i + 1π                CASE AEND$: i = lenlineaπ                END SELECTπ                IF i < 1 THEN i = 1π                IF i > lenlinea THEN i = lenlineaπ                IF tecla$ = CR$ THEN EXIT DOπ                IF LEN(tecla$) < 2 THENπ                        comma(i) = ASC(tecla$)π                        LOCATE inilin, 1: COLOR 7 + 16, 0: PRINT tecla$;π                        SLEEP 1π                END IFπ                IF tecla$ = " " THEN comma(i) = 0π        LOOPπSEEK #1, 1πOPEN LTRIM$(RTRIM$(oufil$)) FOR OUTPUT AS #2πPRINT "Working...";πDOπ        LINE INPUT #1, linea$π        lenlinea = LEN(linea$)π        lineaout$ = ""π        FOR i = 1 TO lenlineaπ                IF i <= UBOUND(comma, 1) THENπ                IF comma(i) <> 0 THEN lineaout$ = lineaout$ + CHR$(comma(i))π                END IFπ                lineaout$ = lineaout$ + MID$(linea$, i, 1)π        NEXT iπ        PRINT #2, lineaout$πLOOP UNTIL EOF(1)πFOR i = -2 TO 5π        SOUND 440 * (2 ^ (i - 10 / 12)), .6πNEXT iπCOLOR 7, 0: PRINT : PRINT "All done! Confused? Me too..."πENDππesperatecla:πtecla$ = ""πWHILE tecla$ = ""π        tecla$ = UCASE$(INKEY$)π        scant$ = MID$(tecla$, 2, 1)πWENDπRETURNπUnknown Author(s)              FULL STRING EDIT               FidoNet QUIK_BAS Echo          Unknown Date           QB, QBasic, PDS        121  5031     FULLEDIT.BASDEFINT A-ZπSUB KeyIn (Ver$, Ln$, Mask$, Fg, Bg, p)ππ'Ln$ = SPACE$(Number of Charecters to accept)π'Ver$ = "ALL"          All Charactersπ'Ver$ = "a-z"          Alpha Lower Caseπ'Ver$ = "A-Z"          Alpha Upper Caseπ'Ver$ = "a-Z"          Alpha Case offπ'Ver$ = "#'s"          Numbers Onlyπ'Mask$ = ""            i.e. To Enter DOB Mask$ would be "  /  /  "π'Fg/Bg                 ForeGround Color/Background Colorπ'p                     Screen Page Numberπ   DIM Chk(10)π   IF Mask$ <> "" THENπ      Ln$ = Mask$π      FOR Chk = 1 TO LEN(Mask$)π         IF MID$(Mask$, Chk, 1) <> " " THEN Temp$ = Temp$ + STR$(Chk)π      NEXT Chkπ      Mask$ = Temp$π   END IFπ   S = POS(0): L = LEN(Ln$): COLOR Fg, Bg: PRINT Ln$; : IF p = 0 THEN p = 1π   IF p > L THEN p = L + 1π   LOCATE , S + p - 1, 1, 7, 7: Temp$ = ""π   Alpha$ = " abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"π   Num$ = " 0123456789"π   IF UCASE$(LEFT$(Ver$, 4)) = "A-Z#" THEN Ver$ = Alpha$ + Num$ + MID$(Ver$, 5)π   SELECT CASE LEFT$(Ver$, 3)π      CASE "ALL": Caps = 0: Ver$ = Alpha$+Num$+"!@#$%^&*()-_+=\[]{};':,./<>? "π      CASE "A-Z": Caps = 1: Ver$ = Alpha$ + MID$(Ver$, 4)π      CASE "a-z": Caps = 2: Ver$ = Alpha$ + MID$(Ver$, 4)π      CASE "a-Z": Caps = 0: Ver$ = Alpha$ + MID$(Ver$, 4)π      CASE "#'s": Caps = 0: Ver$ = Num$ + MID$(Ver$, 4)π      CASE ELSE: Caps = 0π   END SELECTππ   a = 0: e = 0π   WHILE a <> 13 AND a <> 27 AND a <> 10π      DOπ         IF Caps = 0 THEN a$ = INKEY$π         IF Caps = 1 THEN a$ = UCASE$(INKEY$)π         IF Caps = 2 THEN a$ = LCASE$(INKEY$)π      LOOP UNTIL a$ <> ""π      a = ASC(a$): IF a = 0 THEN a = ASC(RIGHT$(a$, 1)) * -1π      p = POS(0) - S + 1: R = POS(0)π      'SCREEN , , 0, 0: COLOR 7, 0: CLS : PRINT a: ENDπ   SELECT CASE aπ      CASE -32                                          ' ALT-D For DosπShellπ         SCREEN , , 0, 0: CLSπ         SHELL "Type EXIT [ENTER] To Return To Program"π         SHELLπ      CASE -77: IF p < L + 1 THEN PRINT CHR$(28);  ELSE BEEP    ' Right arrowπ      CASE -75: IF p <> 1 THEN PRINT CHR$(29);                  ' Left arrowπ      CASE -71: LOCATE , S                                      ' <Home>π      CASE -119                                                 ' <Ctrl+Home>π         LOCATE , S: Ln$ = SPACE$(L): PRINT Ln$; : LOCATE , Sπ      CASE -79π         LOCATE , LEN(RTRIM$(Ln$)) + S                          ' <End>π      CASE -117                                                 ' <Ctrl+End>π         Ln$ = LEFT$(Ln$, p - 1) + SPACE$(L - p + 1)π         LOCATE , S, 0: PRINT Ln$; : LOCATE , R, 1π      CASE -116                                           ' <Ctrl+RightArrow>π         IF p <= L THENπ            Chk = INSTR(p, Ln$, " ")π            IF Chk <> 0 THENπ               Temp$ = LEFT$(LTRIM$(MID$(Ln$, Chk)), 1)π               IF Temp$ <> "" THEN LOCATE , S - 1 + INSTR(Chk, Ln$, Temp$), 1π            ELSEπ               LOCATE , LEN(RTRIM$(Ln$)) + Sπ            END IFπ         END IFπ      CASE -115                                          ' <Ctrl+LeftArrow>π        Temp$ = RTRIM$(LEFT$(Ln$, p - 1))π        IF INSTR(Temp$, " ") THENπ           DO WHILE INSTR(Temp$, " ")π              Chk = INSTR(Temp$, " "): MID$(Temp$, Chk, 1) = "X"π           LOOPπ           LOCATE , Chk + S, 1π        ELSEπ           LOCATE , Sπ        END IFπ      CASE 8                                              ' <Back Space>π         IF p <> 1 THENπ            Ln$ = LEFT$(Ln$, p - 2) + MID$(Ln$, p) + " "π            LOCATE , S, 0: PRINT Ln$; : LOCATE , R - 1, 1π         ELSEπ            Ln$ = RIGHT$(Ln$, L - 1) + " ": LOCATE , S, 0: PRINT Ln$;π            LOCATE , p + S - 1, 1π         END IFπ      CASE 127                                             ' <Ctrl+ BckSpc>π         IF p > L THEN p = Lπ         Ln$ = SPACE$(p) + MID$(Ln$, p + 1)π         LOCATE , S, 0: PRINT Ln$; : LOCATE , R, 1π      CASE -83                                                  '<Delete>π         IF p <= L THENπ            Ln$ = LEFT$(Ln$, p - 1) + MID$(Ln$, p + 1) + " "π            LOCATE , S, 0: PRINT Ln$; : LOCATE , R, 1π         END IFπ      CASE -82                                                 '<Insert>π           IF insert = 0 THEN insert = 1 ELSE insert = 0π           IF insert = 0 THEN LOCATE , , 1, 7, 7π           IF insert = 1 THEN LOCATE , , 1, 4, 7π      CASE ELSEπ         IF INSTR(Ver$, a$) AND p <= L THEN                 ' Print Characterπ            IF insert = 1 THENπ               Ln$ = LEFT$(Ln$, p - 1) + a$ + MID$(Ln$, p, L - p + 1)π               LOCATE , , 0: PRINT MID$(Ln$, p, L - p + 1); : LOCATE , R + 1, 1π            ELSEπ               PRINT a$; : MID$(Ln$, p, 1) = a$π            END IFπ            IF INSTR(Mask$, STR$(p + 1)) THEN PRINT MID$(Ln$, p + 1, 1);π         ELSE IF a <> 13 AND a <> 27 THEN BEEPπ         END IFπ      END SELECTπ   WENDπ   IF a = 27 THEN Ln$ = SPACE$(L)ππEndKeyIn:πLn$ = RTRIM$(Ln$)ππEND SUBπJim Giordano                   DUMP FILE TO SCREEN            FidoNet QUIK_BAS Echo          06-26-93 (18:59)       QB, QBasic, PDS        337  9827     DUMP.BAS    'Dump by Jim Giordano.  Released for all non-comercial use.π'Note: add DEF SEG commented out below for use with Basic 7.1 PDSππDEFINT A-Zπf$ = COMMAND$πIF f$ = "" THENπ   PRINT : PRINT : INPUT "Enter file name to dump - "; f$πEND IFπf$ = LTRIM$(RTRIM$(f$))πIF f$ = "" THEN SYSTEMππOPEN "B", 1, f$, 2048πFLength& = LOF(1)            'Number of bytes to processπIF FLength& = 0 THENπ  PRINT "Error opening filename "; f$; ".  Check for file name error."π  CLOSE #1π  KILL f$ 'eliminate file we just madeπ  SYSTEMπEND IFπTabAmt& = FLength& \ 10      ' 10% tab amountππDIM H$(255), D$(255), aa(255), nn$(255)πFOR i = 0 TO 255π    H$(i) = MID$(HEX$(&H100 + i), 2)π    D$(i) = MID$(STR$(1000 + i), 3)π    IF i < 32 AND (i = 7 OR (i > 8 AND i < 14) OR i > 27) THENπ      aa(i) = -1π    END IFπNEXT iππCLSπff$ = "Dump of file " + f$πLOCATE 1, (80 - LEN(ff$)) \ 2πPRINT ff$π'FOR I = 1 TO 8: PRINT "....+....|"; : NEXT IπGOSUB BottomStuffππD& = 1 'start at first byteπAddOpt = -1  '-1 for decimal, 0 for hexππLinesOfDump = 16ππDmpTyp$ = "Hex"π'DmpTyp$ = "Decimal"πGOSUB SetUpππssc$ = STRING$(17 * 80, " ")   'screenππDOπ   SEEK 1, D&π   a$ = INPUT$(BSize, 1)π's! = TIMER: FOR xxx = 1 TO 80π   pp = 88π   sc$ = ssc$π   Padd& = D&π   IF Padd& > 1000000 THEN  'put millions part aboveπ      TopAmt& = (Padd& \ 1000000) * 1000000π      Padd& = Padd& - TopAmt&π      MID$(sc$, 1) = "Address+" + STR$(TopAmt&)π   END IFπ   FOR p = 1 TO LEN(a$) STEP Stpπ      IF AddOpt THEN    'decimalπ          aaa$ = MID$(STR$(Padd&), 2)π      ELSEπ          aaa$ = HEX$(Padd&)π      END IFπ      MID$(sc$, pp - LEN(aaa$)) = aaa$π      Padd& = Padd& + Stpπ      ppc = pp + 2π      ss$ = MID$(a$, p, Stp)π      ssmax = LEN(ss$) - 1π      FOR i = 0 TO ssmaxπ         'DEF SEG = SSEG(ss$)    '*****note, add this line for qbx pdsπ         ppx& = SADD(ss$)π         aa = PEEK(ppx& + i)π         MID$(sc$, ppc) = nn$(aa)π         ppc = ppc + ppcamtπ         IF aa(aa) THEN POKE ppx& + i, 32π      NEXT iπ      MID$(sc$, pp + ppsamt + 1) = ss$   'ascii charactersπ      pp = pp + 80π   NEXT pπ   LOCATE 3, 1, 0  'turn off cursor for printπ   PRINT sc$;π'NEXT xxx: e! = TIMER: LOCATE 21, 1: PRINT "et="; e! - s!: SYSTEMππ   LOCATE 23, pcol: PRINT blnk$; : LOCATE 23, pcol, 1π   D$ = ""π   DOld& = D&   'wait for a change of positionπ   DOπ      i$ = INKEY$π      i$ = UCASE$(i$)π      IF LEN(i$) = 2 AND LEFT$(i$, 1) = CHR$(0) THEN 'special keyπ         i$ = MID$(i$, 2)π         IF i$ = CHR$(73) THEN      'page upπ            IF D& > BSize THEN D& = D& - BSize ELSE D& = 1π         ELSEIF i$ = CHR$(81) THEN  'page downπ            IF FLength& - D& > BSize THEN D& = D& + BSizeπ         ELSEIF i$ = CHR$(72) THEN  'upπ            IF D& > Stp THEN D& = D& - Stp ELSE D& = 1π         ELSEIF i$ = CHR$(80) THEN  'downπ            IF FLength& - D& > Stp THEN D& = D& + Stpπ         ELSEIF i$ = CHR$(77) THEN  'rightπ            IF D& < FLength& THEN D& = D& + 1π         ELSEIF i$ = CHR$(75) THEN  'leftπ            IF D& > 1 THEN D& = D& - 1π         ELSEIF i$ = CHR$(71) THEN  'homeπ            D& = 1π         ELSEIF i$ = CHR$(79) THEN  'endπ            IF FLength& > BSize THEN D& = FLength& - BSize + 1 ELSE D& = 1π         ELSEIF i$ = CHR$(59) THEN  'f1, helpπ            GOSUB HelpScreenπ            EXIT DOπ         ELSEIF i$ = CHR$(67) THEN  'f9, search againπ            GOSUB SearchAgainπ         ELSEIF i$ = CHR$(92) THEN  'shift f9, search againπ            GOSUB SearchBackwardsπ         ELSEIF i$ = CHR$(15) THEN  'shift tab, back 10%π            IF D& - TabAmt& > 0 THEN D& = D& - TabAmt&π         END IFπ      ELSEIF i$ = "A" THEN       'change addressingπ         AddOpt = NOT AddOptπ         EXIT DO                 'force exit since address didnt changeπ      ELSEIF i$ = "D" THEN      'wants decimalπ         DmpTyp$ = "Decimal"π         GOSUB SetUpπ         EXIT DOπ      ELSEIF i$ = "H" THEN      'wants hexπ         DmpTyp$ = "Hex"π         GOSUB SetUpπ         EXIT DOπ      ELSEIF i$ = "S" THENπ         s$ = "": GOSUB SearchAgain    'go get string to search forπ      ELSEIF i$ = CHR$(9) THEN 'tabπ         IF FLength& > D& + TabAmt& THEN D& = D& + TabAmt&π      ELSEIF i$ = CHR$(13) OR i$ = " " THENπ         IF LEN(D$) = 0 THENπ            IF FLength& - D& > BSize THEN D& = D& + BSizeπ         ELSEπ            IF VAL(D$) <= FLength& THENπ               D& = VAL(D$)π            ELSEπ               BEEPπ            END IFπ         END IFπ      ELSEIF i$ = CHR$(27) THENπ         GOTO wrapπ      ELSEIF i$ >= "0" AND i$ <= "9" THENπ         D$ = D$ + i$: PRINT i$;π      ELSEIF i$ = CHR$(8) THENπ         IF LEN(D$) > 0 THENπ            D$ = LEFT$(D$, LEN(D$) - 1)π            LOCATE , POS(0) - 1π            PRINT " ";π            LOCATE , POS(0) - 1π         END IFπ      END IFπ   LOOP WHILE D& = DOld& AND force = 0π   DO  'clear pending keysπ   LOOP WHILE LEN(INKEY$)πLOOP WHILE D& > 0πwrap:πSYSTEMππBottomStuff:πLOCATE 22, 1πPRINT FLength&; "characters available on file"πPRINT "Enter starting character number to dump - ";πpcol = POS(0)πblnk$ = SPACE$(80 - pcol)πPRINT : PRINT "Press F1 for commands";πRETURNππHelpScreen:πLOCATE 3, 1πhlpblnk$ = SPACE$(60)πFOR hb = 1 TO 18π   LOCATE , 10: PRINT hlpblnk$πNEXT hbπLOCATE 4, 1πts = 16πLOCATE , ts: PRINT "    Possible actions are as follows:"πPRINTπLOCATE , ts: PRINT "Escape key = quit program"πLOCATE , ts: PRINT "PgUp = up one page"πLOCATE , ts: PRINT "PgDn, space bar or Enter key = down one page"πLOCATE , ts: PRINT "Home = start of file,  End = end of file"πLOCATE , ts: PRINT "Up or Down = up or down one line"πLOCATE , ts: PRINT "Left or Right = up or down one byte"πLOCATE , ts: PRINT "S = enter string to search for"πLOCATE , ts: PRINT "F9 = search for string"πLOCATE , ts: PRINT "Shift-F9 = search backward for string"πLOCATE , ts: PRINT "Tab = move down file 10%,  Shift-Tab = Up 10%"πLOCATE , ts: PRINT "A = toggle address from Hex to Decimal"πLOCATE , ts: PRINT "D = dump in decimal,  H = dump in hex"πPRINTπLOCATE , 16: PRINT "    Press any key to continue - ";πSLEEPπRETURNππSearch:π   LOCATE 20, 1, 0π   FOR bb = 1 TO 4: PRINT SPACE$(80): NEXT bbπ   LOCATE 20, 1π   PRINT "Enter string to search for, left arrow to backspace, press F9 when done"π   s$ = ""π   PRINT "ASCII   = "π   PRINT "Decimal = "π   PRINT "Hex     = "π   DOπ      DOπ         Sx$ = INKEY$π      LOOP WHILE Sx$ = ""π      IF LEN(Sx$) > 1 THEN  'possible function keyπ         IF ASC(MID$(Sx$, 2)) = 75 THEN 'left arrow key, backspaceπ             IF LEN(s$) > 0 THENπ                s$ = LEFT$(s$, LEN(s$) - 1)π                FOR bb = 21 TO 23π                    LOCATE bb, LEN(s$) * 4 + 13: PRINT "    "π                NEXT bbπ             END IFπ         ELSEIF ASC(MID$(Sx$, 2)) = 67 THEN 'f9, wrap upπ             EXIT DOπ         END IFπ      ELSEIF LEN(s$) * 4 + 14 < 80 THENπ         LOCATE 21, LEN(s$) * 4 + 14π         aa = ASC(Sx$)π         IF aa < 32 AND (aa = 7 OR (aa > 8 AND aa < 14) OR aa > 27) THENπ              'dont PRINTπ         ELSEπ               PRINT Sx$π         END IFπ         LOCATE 22, LEN(s$) * 4 + 13π         PRINT D$(aa)π         LOCATE 23, LEN(s$) * 4 + 13π         PRINT H$(aa)π         s$ = s$ + Sx$π      END IFπ   LOOPπ         π   LOCATE 20, 1, 0:π   FOR bb = 1 TO 4: PRINT SPACE$(80): NEXT bbπ   GOSUB BottomStuffπ   RETURNππSearchAgain:ππ   IF s$ = "" THENπ      GOSUB Searchπ      IF s$ = "" THEN RETURN  'no changeπ   END IFπ   DO: LOOP WHILE LEN(INKEY$) > 0       'clear key boardπ   DOld& = D&π   DOπ      Sx = INSTR(2, a$, s$)π      IF Sx > 0 THENπ         D& = D& + Sx - 1   'new start of pageπ         RETURNπ      END IFπ      IF FLength& - D& > BSize THENπ          D& = D& + BSizeπ          SEEK 1, D&π          a$ = INPUT$(BSize, 1)π      ELSEπ          BEEPπ          RETURN   'stay at last found d&π      END IFπ      GOSUB SeeIfAbortπ      IF AbortSearch THEN D& = DOld&: RETURNπ   LOOPππSearchBackwards:ππ   IF s$ = "" THENπ      GOSUB Searchπ      IF s$ = "" THEN RETURN  'no changeπ   END IFπ   DO: LOOP WHILE LEN(INKEY$) > 0       'clear key boardπ   DOld& = D&π   DOπ      IF D& = 1 THENπ          BEEPπ          RETURN  'at beginning of fileπ      END IFπ      IF D& > BSize THEN D& = D& - BSize ELSE D& = 1π      SEEK 1, D&π      a$ = INPUT$(BSize, 1)π      Sx = INSTR(a$, s$) 'find first occurance this pageπ      IF Sx > 0 AND Sx < DOld& THEN 'found oneπ        DOπ         nxsx = INSTR(Sx + 1, a$, s$)π         IF nxsx = 0 OR nxsx >= DOld& THENπ            D& = D& + Sx - 1   'new start of pageπ            RETURNπ         END IFπ         Sx = nxsx   'use later oneπ        LOOPπ      END IFπ      GOSUB SeeIfAbortπ      IF AbortSearch THEN D& = DOld&: RETURNπ   LOOPπSTOP 'will never get hereππSeeIfAbort:π   AbortSearch = 0 'preset falseπ   IF INKEY$ <> "" THENπ      LOCATE 25, 1: PRINT "Abort Search ? <N>";π      DOπ        qs$ = INKEY$π      LOOP WHILE qs$ = ""π      LOCATE 25, 1: PRINT "                   ";π      qs$ = UCASE$(qs$)π      IF qs$ = "Y" THEN AbortSearch = -1π   END IFπ   RETURNπππSetUp:πIF DmpTyp$ = "Decimal" THENπ  Stp = 14            'number of items per lineπ  BSize = Stp * LinesOfDump    'block size to readπ  qq$ = STRING$(Stp * 4 + 2, " ")  'string to hold dump valuesπ  ppsamt = 65 - 8π  ppcamt = 4π  nnamt = 1π  FOR i = 0 TO 255: nn$(i) = D$(i): NEXT iπELSEIF DmpTyp$ = "Hex" THENπ  Stp = 16π  BSize = Stp * LinesOfDumpπ  qq$ = STRING$(Stp * 3 + 8, " ")π  ppsamt = 60 - 8π  ppcamt = 3π  nnamt = 2π  FOR i = 0 TO 255: nn$(i) = H$(i): NEXT iπEND IFπRETURNππUnknown Author(s)              PRINT HUGE CHARACTERS          FidoNet QUIK_BAS Echo          09/95                  QB, QBasic, PDS        90   2606     HUGECHAR.BASCONST MaxSlides = 65       '<<-- Enter Number of Slides Here (65)πCONST MaxPause = 90        '<<-- Enter Number of Seconds to Pause (90)ππDECLARE SUB GetVideoSeg ()πDECLARE SUB BigChar (CharCode%)πDECLARE SUB BigPrint (Text$)πDECLARE SUB CountTime ()πDIM SHARED VideoSeg&πSCREEN 0: WIDTH 80, 25: CLSπCALL GetVideoSegπFOR a% = MaxSlides TO 1 STEP -1π   CLSπ   LOCATE 1, 50: PRINT "  Press SPACE to PAUSE"π   LOCATE 3, 50: PRINT "Press ENTER for NEXT SLIDE"π   LOCATE 5, 50: PRINT "   Press ESC to EXIT"π   LOCATE 1, 1: CALL BigPrint(LTRIM$(STR$(a%)))π   CALL CountTimeπ   SOUND 200, 2: SOUND 32000, 1: SOUND 200, 2πNEXT a%πENDππSUB BigChar (CharCode%)π'--- Displays a BIG Character at current Cursor Location ---πXpos% = POS(0): Ypos% = CSRLINπDEF SEG = &HF000πFOR ScanLine% = 0 TO 7π   BitCode% = PEEK(&HFA6E + ScanLine% + CharCode% * 8)π   LOCATE Ypos% + ScanLine%, Xpos%π   FOR Bits% = 1 TO 8π      IF BitCode% < 128 THEN Show$ = "  " ELSE Show$ = CHR$(219) + CHR$(178)π      PRINT Show$;π      IF BitCode% > 127 THEN BitCode% = BitCode% - 128π      BitCode% = BitCode% * 2π   NEXT Bits%πNEXT ScanLine%πDEF SEGπLOCATE Ypos%, Xpos%πEND SUBππSUB BigPrint (Text$)π'--- Displays a BIG String at current Cursor Location ---πXpos% = POS(0): Ypos% = CSRLINπFOR a% = 1 TO LEN(Text$)π   Xtemp% = (a% - 1) * 16 + Xpos%π   LOCATE Ypos%, Xtemp%π   CALL BigChar(ASC(MID$(Text$, a%, 1)))πNEXT a%πLOCATE Ypos%, Xpos%πEND SUBππSUB CountTimeπ'---  Counts the time for Each Slide. Includes Pausing ---πFOR a% = MaxPause TO 1 STEP -1π   T! = TIMERπ   LOCATE 10, 1: PRINT "You Have"; a%; "Seconds Left...   "π   IF a% = 10 THENπ      LOCATE 14, 25: PRINT "****  10 Second Warning!  ****"π      SOUND 130, 2π   END IFπ   DO: I$ = INKEY$π   LOOP UNTIL (TIMER > T! + 1) OR (I$ <> "")    '<-- Pause for 1 Secondπ   IF I$ = " " THENπ      '--- Press SPACE to Pause ---π      LOCATE 15, 1: CALL BigPrint("Pause")π      I$ = INPUT$(1)π      CALL BigPrint("     ")π   ELSEIF I$ = CHR$(13) THENπ      '--- Press ENTER to Skip to Next Slide ---π      EXIT SUBπ   ELSEIF I$ = CHR$(27) THENπ      '--- Press ESC to Exit Program ---π      CLS : LOCATE 8, 12π      CALL BigPrint("Bye!")π      ENDπ   END IFπNEXT a%πEND SUBππSUB GetVideoSegπ'---  Just Does some Setting Up Stuff... ---π   VideoSeg& = 0π   DEF SEG = &H40: VideoMode% = PEEK(&H49)π   IF VideoMode% = 7 THEN VideoSeg& = &HB000π   IF VideoMode% < 4 THEN VideoSeg& = &HB800π   IF VideoSeg& = 0 THENπ      LOCATE 12, 25: PRINT "ERROR: Unfamiliar video mode!"π      ENDπ   END IFπEND SUBππErik Olson                     EDIT STRING IN BOX             EDIT,STRING,IN,BOX             Unknown Date           PB                     93   2488     EDITBOX.BAS $IF 0ππ'   THIS FILE: EDITBOX$.BAS for PowerBASICπ'      AUTHOR: Erik Olsonπ' DESCRIPTION: Function to edit a string in a boxππ$ENDIFππ' this subroutine already contains SINBOX.BAS, which draws a box aroundπ' the input line.  You can, of course, use your own box routine, orπ' not use one at all.ππ' EDITBOX$ is a function which returns whatever was typed into the field.π' DEFAULT$ is the argument, which should be padded with spaces to equal theπ' total size of the edit field.πππ' Example:ππA$=EditBox$("This is the Default     ")πCLSπIF A$="" THEN PRINT "You aborted" ELSE PRINT "You entered: ";A$πππππFUNCTION EditBox$(Default$)ππCOLOR 0,7πCALL SingleBox(19, 38-(LEN(Default$)\2), 21, 42+(LEN(Default$)\2))πy = 40 - (LEN(Default$) \ 2) : YY=0πDOπππ   LOCATE 20,Y,0:PRINT Default$  ' if you want to put the box somewhereπ   LOCATE  20,Y+yy,1             ' else, change these locate statementsπππ   DO:A$=INKEY$:LOOP WHILE LEN(A$)=0π   IF LEN(A$) THENπ      SELECT CASE(A$)π      CASE CHR$(27), CHR$(13)π         EXIT SELECTπ      CASE CHR$(8)π         IF YY THENπ            YY=YY-1π            IF YY THENπ               Default$=LEFT$(Default$,yy)+MID$(Default$,yy+2) + " "π            ELSEπ               Default$=MID$(Default$,yy+2) + " "π            END IFπ         END IFπ      CASE CHR$(0)+CHR$(83)π         IF YY THENπ            Default$=LEFT$(Default$,yy)+MID$(Default$,yy+2) + " "π         ELSEπ            Default$=MID$(Default$,yy+2) + " "π         END IFπ      CASE CHR$(0)+CHR$(&H4D)π         IF YY < LEN(Default$) THEN YY=YY+1π      CASE CHR$(0)+CHR$(&H4B)π         IF YY THEN YY=YY-1π      CASE CHR$(0)+CHR$(79) 'endπ         yy=LEN(RTRIM$(default$))π      CASE CHR$(0)+CHR$(71)π         yy=0ππ      CASE ELSEπ         IF LEN(A$)=1 and YY=0 THEN Default$=SPACE$(LEN(default$))π         IF LEN(A$)=1 and YY < LEN(Default$) THEN_π         MID$(Default$,YY+1,1) = A$ : YY=YY+1ππ      END SELECTπ      IF A$=CHR$(27) THEN EditBox$="":EXIT LOOPπ      IF A$=CHR$(13) THEN EditBox$=RTRIM$(Default$):EXIT LOOPππ   END IFπLOOPπEND FUNCTIONπππππSUB SingleBox (Wa%, Wb%, Wc%, Wd%)π   LOCATE Wa%, Wb%: PRINT CHR$(213) + STRING$((Wd% - Wb%) - 1, 205) + CHR$(184)π   LOCATE Wc%, Wb%: PRINT CHR$(212) + STRING$((Wd% - Wb%) - 1, 205) + CHR$(190)ππ   FOR zxy% = 1 TO Wc% - Wa% - 1π      LOCATE Wa% + zxy%, Wb%π      PRINT CHR$(179) + SPACE$((Wd% - Wb%) - 1) + CHR$(179)π   NEXT zxy%ππEND SUBπJohn Sneeringer                COPY A FILE                    QBFAQ                          03-02-92 (19:11)       QB, QBasic, PDS        21   678      DOS.BAS            ' ===========================================================π       '  Copy File From Command Line -> Named to whatever F2$ is.π       ' ===========================================================ππ       F1$ = COMMAND$    ' Target filename from command lineππ       INPUT "New Name?"; F2$      ' name of file you want to copy toππ       OPEN "B", 1, F1$π       OPEN "B", 2, F2$π       A$ = SPACE$(1024)π       FOR i = 1 TO LOF(1) \ 1024π          GET 1, , A$π          PUT 2, , A$π       NEXT iπ       IF LOF(1) MOD 1024 > 0 THENπ           A$ = SPACE$(LOF(1) MOD 1024)π           GET 1, , A$π           PUT 2, , A$π       END IFπ       CLOSE 1, 2πJohn White/Dan Bridges         LINE WRAPPING                  FidoNet QUIK_BAS Echo          09-20-92 (19:57)       QB, QBasic, PDS        165  4661     WRAPLINE.BAS' WRAPLINE.BAS, Public Domain, John White 1:3636/2, 09-09-92π' With additions by Dan Bridges 3:640/820.2 @Fidonet, 20-Sep-92π' StrLen =  Maximum length of each lineπ' StrIn$ = The string to parseπ' Work$  = Temp variable for parsingπ' WorkPlus$ = Used to ensure that words aren't splitπ' ParsedLines$() = Array holding the parsed stringsπ' NumOfLines = Maximum number of parsed strings in ParsedLines$()π' GoNoLower = Ensures that line length is bigger than biggest wordπ'======================================================================ππDEFINT A-ZπDECLARE FUNCTION MaxWordLen (StrIn$)πDECLARE SUB WrapLine (StrLen, StrIn$, ParsedLines$(), NumOfLines)πDECLARE SUB DisplayArray (ParsedLines$(), NumOfLines, StrLen)πDECLARE SUB VaryLineLength (GoNoLower, StrLen, StrIn$, ParsedLines$(), NumOfLines)ππStrLen = 40ππDIM ParsedLines$(255)ππCONST False = 0, True = NOT FalseππStrIn$ = "This is a very, very, very, long line and I think it will never end. Then again: it eventually must."ππGoNoLower = MaxWordLen(StrIn$)ππCLSππCALL WrapLine(StrLen, StrIn$, ParsedLines$(), NumOfLines)πCALL DisplayArray(ParsedLines$(), NumOfLines, StrLen)πCALL VaryLineLength(GoNoLower, StrLen, StrIn$, ParsedLines$(), NumOfLines)ππENDππSUB DisplayArray (ParsedLines$(), NumOfLines, StrLen)ππCLSππIF NumOfLines = 0 THENπ  PRINT "No Data in StrIn$"π  ENDπEND IFππCOLOR 15, 0πPRINT LEFT$("....x....1....x....2....x....3....x....4....x....5....x....6....x....7....x....8", StrLen)π' Replace "x"s above with Alt-254 characters (small block).π' High ASCII characters replaced for Fidonet transmission.πCOLOR 7, 0ππFOR LineNum = 1 TO NumOfLinesπ  PRINT ParsedLines$(LineNum)πNEXT LineNumππNumOfLines = 0ππEND SUBππFUNCTION MaxWordLen (StrIn$)ππ  StrIn$ = LTRIM$(RTRIM$(StrIn$))ππ  IF INSTR(StrIn$, " ") = 0 THENπ    MaxWordLen = LEN(StrIn$)π    EXIT FUNCTIONπ  END IFππ  Space1 = INSTR(StrIn$, " ")ππ  DOπ    Space2 = INSTR(Space1 + 1, StrIn$, " ")ππ    IF Space2 = 0 THENπ      WordLen = LEN(StrIn$) - Space1π    ELSEπ      WordLen = Space2 - Space1 - 1π    END IFππ    IF WordLen > TempMaxLen THEN TempMaxLen = WordLenπ    Space1 = Space2π  LOOP WHILE Space2ππ    MaxWordLen = TempMaxLenππEND FUNCTIONππSUB VaryLineLength (GoNoLower, StrLen, StrIn$, ParsedLines$(), NumOfLines)ππDOπ  SELECT CASE INKEY$ππ  CASE CHR$(45)  'Action if Grey Minus Key is pressedπ    IF StrLen = GoNoLower THENπ      LOCATE 24, 9: BEEPπ      PRINT "Requested Right Margin is less than the length of the longest word."π      LOCATE 25, 9π      PRINT "Margin reduction command ignored! Press any key to clear this message...";π      DO: LOOP WHILE INKEY$ = ""π      CLSπ    ELSEπ      StrLen = StrLen - 1π    END IFπ    CALL WrapLine(StrLen, StrIn$, ParsedLines$(), NumOfLines)π    CALL DisplayArray(ParsedLines$(), NumOfLines, StrLen)ππ  CASE CHR$(43)  'Action if Grey Plus Key is pressedπ    IF StrLen = 80 THENπ      LOCATE 24, 9: BEEPπ      PRINT "Requested Right Margin is greater than 80 characters.";π      LOCATE 25, 9π      PRINT "Margin expansion command ignored! Press any key to clear this message...";π      DO: LOOP WHILE INKEY$ = ""π      CLSπ    ELSEπ      StrLen = StrLen + 1π    END IFπ    CALL WrapLine(StrLen, StrIn$, ParsedLines$(), NumOfLines)π    CALL DisplayArray(ParsedLines$(), NumOfLines, StrLen)ππ  CASE CHR$(27)  'Action if Esc Key is pressedπ    EXIT DOππ  END SELECTπLOOPππEND SUBππSUB WrapLine (StrLen, StrIn$, ParsedLines$(), NumOfLines)ππ  IF StrIn$ = "" THENπ    NumOfLines = 0π    EXIT SUBπ  END IFπ  'If string to split is nothing, exit.ππ  Work$ = StrIn$                     'Keep original value in StrIn$π  Done = False                       'reset flagππ  DOπ    IF LEN(Work$) > StrLen THENπ      NumOfLines = NumOfLines + 1    'Increment index to arrayπ      WorkPlus$ = LEFT$(Work$, StrLen + 1)π      'WorkPlus$ is used to see if there is a space immediatelyπ      'after the requested split point so we do not split a word.ππ      FOR SearchStartPos = StrLen TO 1 STEP -1π        LastSpacePos = INSTR(SearchStartPos, WorkPlus$, " ")π        IF LastSpacePos THENπ          ParsedLines$(NumOfLines) = LTRIM$(RTRIM$(LEFT$(Work$, LastSpacePos)))  'Put left (StrLen) chars in arrayπ          Work$ = MID$(Work$, SearchStartPos + 1)π          'Remove parsed segment from Work$π          EXIT FORπ        END IFπ      NEXT SearchStartPosππ    ELSEπ      Done = Trueπ    END IFπ  LOOP UNTIL Doneππ  NumOfLines = NumOfLines + 1   'Save remainder of StrIn$π  ParsedLines$(NumOfLines) = LTRIM$(Work$)ππEND SUBππBert Christensen               INPUT ROUTINES                 PC Resources                   10/93 (00:00)          QB, QBasic, PDS        524  24442    ROSEQBAS.BAS'π' ROSEWOOD QUICKBASIC STUFF v 1 consists of two programs which can beπ' incorporated into programs written in QuickBasic 4.xx or QBasic whichπ' is supplied with MS DOS 5 and 6. Libraries or commands such asπ' CALL INTERRUPT not used in QBasic are not needed with this code.π'π' There are two distinct parts of the program:π'π'   The first is an input editor which will replace the commands "INPUT",π' "LINE INPUT", etc. with an input routine written with INKEY$ as the input.π' INKEY$ allows much nicer inputting, especially if you have several inputsπ' to process in succession. This editor can be set up to accept various typesπ' of input and to block other types. This will greatly reduce the amount ofπ' error checking which is associated with the usual input functions.π'   Some parts of this program may look ancient with its IF..ENDs and GOTOs.π' However, I like to have the ability to cascade through the editor. Seeπ' how scan% = 8 becomes scan% = 83 in the backspace command area. The programπ' could be written using only DO..LOOP, SELECT CASE etc. but I doubt that itπ' would make the program work better. It would be prettier though.π' The editor is very loosely based on a program from the magazine,π' PC RESOURCES, October 1987, pg. 61π'π'   The second part of the code is a simple window program. Windows of anyπ' size or colour, with or without a border, can be placed anywhere on theπ' screen with text justified left, centre and right, and then wiped off soπ' that the original screen below is restored. The speed in drawing andπ' erasing these windows is not as great as windows using registers andπ' CALL ABSOLUTE, but it is adequate for most purposes.ππ' This code is written by:      Bert Christensenπ'                               Rosewood Softwareπ'                               135-10 Livonia Placeπ'                               Scarborough, Ontario, Canada M1E 4W6π'                               [phone], CompuServe 70461,2507π'                               Internet [e-mail]π'π'                               Copyright (c) 1993 by Bert Christensenπ'π' Anyone is granted full permission to use all or part of this programπ' without charge. However, if you should feel moved to send a donation,π' it will not be refused.π'π' Any comments would be appreciated.π'π'π'           ROSEWOOD QUICKBASIC STUFF v 1π'π'           Programmed in MicroSoft QuickBasic 4.5 and VisualBasic for DOS 1.00π'           October 1993π'π'π'        ******DECLARATIONS*****ππDECLARE SUB Fulledit (row%(), column%(), numentry%, inperr%(), item$(), itemlen%(), itemflag%())πDECLARE SUB WindowSub (wintop%, winbot%, winleft%, winright%, winforecolour%, winbackcolour%, wintext$(), winborder%)πDECLARE FUNCTION Justify$ (text$, just%, winleft%, winright%)πDECLARE SUB Frame (toprow%, bottomrow%, leftcol%, rightcol%)πCOMMON SHARED /colours/ sfg%, sbg%, rfg%, rbg%, ffg%, fbg%πsfg% = 0        'standard foregroundπsbg% = 7        'standard backgroundπrfg% = 7        'reverse foregroundπrbg% = 1        'reverse backgroundπREM ffg% = frame foregroundπREM fbg% = frame backgroundπππREM ******************EDITOR SECTION**********************ππLOCATE 1, 1     'goto top left so whole screen will be "coloured"πCOLOR sfg%, sbg%πCLSπCOLOR rfg%, rbg%π' place prompts on the screenπLOCATE 1, 12: PRINT "`Rosewood QB Stuff' Input Editor for QuickBasic & QBasic"πCOLOR sfg%, sbg%πLOCATE 3, 5: PRINT "This field accepts 0 to 9 & space only"; : LOCATE 5, 5: PRINT "This field accepts all alphanumeric entries";πLOCATE 7, 5: PRINT "This field accepts `0' to `9',`-', `.' and `space' only"; : LOCATE 9, 5: PRINT "The Esc key is disabled in this field";πLOCATE 11, 5: PRINT "Edit pre-existing data"; : LOCATE 13, 5: PRINT "Field length of 1"; :   LOCATE 15, 5: PRINT "Field length of 45";πLOCATE 17, 27: PRINT "Fields can be placed anywhere on screen"πLOCATE 19, 1: PRINT STRING$(80, "*");πLOCATE 20, 5: PRINT "Use arrow keys, Home, End, PgUp, PgDn, Del, Bksp, Ins to edit";πLOCATE 21, 5: PRINT "Ctrl F3 to delete input; Ctrl F4 to copy text; Ctrl F5 to paste";πLOCATE 22, 5: PRINT "Ctrl End & Ctrl Home to move to ends of field; Ctrl F10 to quit editing";πLOCATE 23, 5: PRINT "Ctrl F6 to centre text";πentryload$ = "Bert Christensen, Rosewood Software"      'see item$(5) belowπnumentry% = 8   'number of input items. can be 1 to ??ππREDIM item$(numentry%), itemlen%(numentry%), inperr%(numentry%), row%(numentry%), column%(numentry%), itemflag%(numentry%)ππ'item$() = the input item. if there is data to be edited, see below at item$(5).π'if there is no data to be edited then item$() = " ".π'itemlen%() = the length of the item$().π'inperr%() is a flag to manipulate data in the sub, Fulleditπ'column%() is the horizontal column position to start the editing of the particular item$()π'row%() is the vertical row to start editing the item$()π'itemflag%() is like inperr%() above (in case you should need 2)π'below is the filling of the arrrayππ        item$(1) = " ": itemlen%(1) = 5: inperr%(1) = 0: column%(1) = 44: row%(1) = 3: itemflag%(1) = 1π        item$(2) = " ": itemlen%(2) = 25: inperr%(2) = 0: column%(2) = 50: row%(2) = 5: itemflag%(2) = 0π        item$(3) = " ": itemlen%(3) = 10: inperr%(3) = 0: column%(3) = 64: row%(3) = 7: itemflag%(3) = 2π        item$(4) = " ": itemlen%(4) = 6: inperr%(4) = 1: column%(4) = 45: row%(4) = 9: itemflag%(4) = 0      'inperr% = 1π        item$(5) = entryload$: itemlen%(5) = 40: inperr%(5) = 0: column%(5) = 30: row%(5) = 11: itemflag%(5) = 0π        item$(6) = " ": itemlen%(6) = 1: inperr%(6) = 0: column%(6) = 25: row%(6) = 13: itemflag%(6) = 0π        item$(7) = " ": itemlen%(7) = 45: inperr%(7) = 0: column%(7) = 24: row%(7) = 15: itemflag%(7) = 0π        item$(8) = " ": itemlen%(8) = 20: inperr%(8) = 0: column%(8) = 5: row%(8) = 17: itemflag%(8) = 0ππCALL Fulledit(row%(), column%(), numentry%, inperr%(), item$(), itemlen%(), itemflag%())ππCLSππREM *****************BACKGROUND PATTERN SECTION*****************ππFOR row% = 1 TO 25π    FOR column% = 1 TO 80π        LOCATE row%, column%π        COLOR sfg%, sbg%π        PRINT CHR$(177);      'fill screen with background patternπ    NEXT column%πNEXT row%ππREM ****************WINDOWS SECTION******************ππ    wintop% = 8             'initialize placement of windowπ    winbot% = 21            '     "         "     "     "π    winleft% = 10           '     "         "     "     "π    winright% = 70          '     "         "     "     "πππDIM wintext$(winbot% - wintop% + 1)  'dimension array for lines of textππ    REM wintext$(1) is a null string because the frame will cover itπ    wintext$(2) = Justify$("Results returned by Rosewood QB Stuff Input Editor", 2, winleft%, winright%)π    wintext$(4) = "item$(1) = " + item$(1)π    wintext$(5) = "item$(2) = " + item$(2)π    wintext$(6) = "item$(3) = " + item$(3)π    wintext$(7) = "item$(4) = " + item$(4)π    wintext$(8) = Justify$("item$(5) = " + item$(5), 1, winleft%, winright%) 'see justify$ functionπ    wintext$(9) = Justify$("item$(6) = " + item$(6), 0, winleft%, winright%)π    wintext$(10) = "item$(7) = " + item$(7)π    wintext$(11) = Justify$("item$(8) = " + item$(8), 0, winleft%, winright%)π    wintext$(12) = ""π    wintext$(13) = Justify$("Press any key to continue...", 2, winleft%, winright%)ππCALL WindowSub(wintop%, winbot%, winleft%, winright%, 15, 4, wintext$(), 1)ππREM ***********SECOND WINDOW**********ππwintop% = 10πwinbot% = 22πwinleft% = 10πwinright% = 40ππREDIM wintext$(winbot% - wintop% + 1)ππFOR x% = 2 TO 6π    wintext$(x%) = Justify$("Right Justified", 3, winleft%, winright%)πNEXT x%ππCALL WindowSub(wintop%, winbot%, winleft%, winright%, 15, 3, wintext$(), 0)ππREM **********THIRD WINDOW**********ππwintop% = 6πwinbot% = 11πwinleft% = 4πwinright% = 40ππREDIM wintext$(winbot% - wintop% + 1)πFOR x% = 2 TO 6π    wintext$(x%) = Justify$("Centered Text", 2, winleft%, winright%)πNEXT x%πCALL WindowSub(wintop%, winbot%, winleft%, winright%, 15, 6, wintext$(), 1)ππREM *********FOURTH WINDOW***********ππwintop% = 13πwinbot% = 23πwinleft% = 10πwinright% = 70ππREDIM wintext$(winbot% - wintop% + 1)πwintext$(2) = Justify$("ROSEWOOD QUICKBASIC STUFF is brought to you by:", 2, winleft%, winright%)πwintext$(3) = Justify$("Bert Christensen", 2, winleft%, winright%)πwintext$(4) = Justify$("Rosewood Software", 2, winleft%, winright%)πwintext$(5) = Justify$("135-10 Livonia Place", 2, winleft%, winright%)πwintext$(6) = Justify$("Scarborough, Ontario M1E 4W6  Canada", 2, winleft%, winright%)πwintext$(7) = Justify$("Telephone [phone]", 2, winleft%, winright%)πwintext$(8) = Justify$("CompuServe 70461,2507  Internet [e-mail]", 2, winleft%, winright%)πwintext$(10) = Justify$("Copyright (c) 1993", 2, winleft%, winright%)πCALL WindowSub(wintop%, winbot%, winleft%, winright%, 15, 5, wintext$(), 1)πCOLOR sfg%, sbg%ππENDππSUB Frame (toprow%, bottomrow%, leftcol%, rightcol%)ππ        LOCATE toprow%, leftcol%: COLOR ffg%, fbg%: PRINT CHR$(201)  'top left cornerπ        LOCATE toprow%, rightcol%: COLOR ffg%, fbg%: PRINT CHR$(187) 'top right cornerπ        LOCATE bottomrow%, leftcol%: COLOR ffg%, fbg%: COLOR ffg%, fbg%: PRINT CHR$(200); 'bottom left cornerπ        LOCATE bottomrow%, rightcol%: COLOR ffg%, fbg%: PRINT CHR$(188); 'bottom right cornerππ        FOR vertline% = toprow% + 1 TO bottomrow% - 1       'vertical linesπ                LOCATE vertline%, leftcol%: COLOR ffg%, fbg%: PRINT CHR$(186);π                LOCATE vertline%, rightcol%: COLOR ffg%, fbg%: PRINT CHR$(186);π        NEXT vertline%ππ                horizlength% = rightcol% - leftcol% - 1     'horizontal linesπ                horizline$ = STRING$(horizlength%, 205)π        LOCATE toprow%, leftcol% + 1: COLOR ffg%, fbg%: PRINT horizline$π        LOCATE bottomrow%, leftcol% + 1: COLOR ffg%, fbg%: PRINT horizline$;π        LOCATE , , 0πEND SUBππSUB Fulledit (row%(), column%(), numentry%, inperr%(), item$(), itemlen%(), itemflag%())ππ'there are some Wordstar type commands "scan% = 19 is Ctrl S". I hate Wordstar so I never completed all the commands.ππLOCATE , , 0πinsertkey% = 0     'make typeover the defaultπsc1% = 6           'cursor size for default typeoverπsc2% = 7π        FOR menuitem% = 1 TO numentry%                  'make sure that existing entries have proper lengthπ                IF LEN(item$(menuitem%)) < itemlen%(menuitem%) THENπ                        item$(menuitem%) = item$(menuitem%) + STRING$((itemlen%(menuitem%) - LEN(item$(menuitem%))), " ") 'pad with spacesπ                ELSEIF LEN(item$(menuitem%)) > itemlen%(menuitem%) THENπ                        item$(menuitem%) = LEFT$(item$(menuitem%), itemlen%(menuitem%))  'truncate if necessaryπ                END IFπ        NEXT menuitem%π        itemnum% = 1    'start a first input entryπ        FOR entry% = 1 TO numentry%                         'enter default data and/or spaces in proper placesπ                colm% = column%(entry%)π                FOR leng% = 1 TO itemlen%(entry%)π                        COLOR rfg%, rbg%π                        LOCATE row%(entry%), colm%π                        defaultstr$ = MID$(item$(entry%), leng%, 1)π                        PRINT defaultstr$;π                        colm% = colm% + 1π                NEXT leng%π        NEXT entry%π        printcolumn% = column%(itemnum%)     'start at leftmost columnπed1:    COLOR rfg%, rbg%: LOCATE row%(itemnum%), printcolumn%, 1, sc1%, sc2%                   'Place the cursorππed2:    keypress$ = "": keypress$ = INKEY$: IF keypress$ = "" THEN GOTO ed2     'wait for keypressπ        scan% = ASC(keypress$)     'change keypress to integerπed4:π        IF scan% = 27 THEN                'Escπ                IF inperr%(itemnum%) = 1 THEN  ' to prevent user from escaping from subπ                        BEEPπ                ELSEπ                        EXIT SUBπ                END IFπ        END IFππ        IF scan% > 31 AND scan% < 127 THEN           'Alphanum chars onlyπ                DOπ                        SELECT CASE itemflag%(itemnum%)       'determine which set of characters are acceptableπ                                CASE 0          'any alpha numericπ                                CASE 1          ' 0 to 9 and spaceπ                                        SELECT CASE scan%π                                                CASE 32, 48 TO 57   ' nothing to do. Let if "fall through" the SELECT CASEπ                                                CASE ELSEπ                                                        BEEPπ                                                        GOTO ed2π                                        END SELECTπ                                CASE 2         '0 to 9, -,., spaceπ                                        SELECT CASE scan%π                                                CASE 32, 45, 46, 48 TO 57π                                                CASE ELSEπ                                                        BEEPπ                                                        GOTO ed2π                                        END SELECTπ                        END SELECTππ                IF insertkey% = 0 THEN                     'typeoverπ                        MID$(item$(itemnum%), printcolumn% - column%(itemnum%) + 1, 1) = keypress$π                        PRINT keypress$;ππ                ELSEπ                        item$(itemnum%) = LEFT$(LEFT$(item$(itemnum%), printcolumn% - column%(itemnum%)) + CHR$(scan%) + MID$(item$(itemnum%), printcolumn% - column%(itemnum%) + 1, column%(itemnum%)), itemlen%(itemnum%))           'insertπ                        LOCATE row%(itemnum%), column%(itemnum%), 1, sc1%, sc2%π                        item$(itemnum%) = LEFT$(item$(itemnum%), itemlen%(itemnum%))π                        PRINT item$(itemnum%);π                END IFπ                scan% = 77                                   'move right 1 spaceπ                EXIT DOπ                LOOPπ        END IFππ        IF scan% = 8 AND printcolumn% > column%(itemnum%) THEN          'Back Spaceπ                printcolumn% = printcolumn% - 1π                LOCATE row%(itemnum%), printcolumn%, 1, sc1%, sc2%π                scan% = 83π        END IFππ        IF scan% = 0 THEN scan% = ASC(RIGHT$(keypress$, 1))             'Extended characterππ                                ' scan% = 4 is the Wordstar Ctrl Dπ        IF (scan% = 77 OR scan% = 4) AND printcolumn% < column%(itemnum%) - 1 + itemlen%(itemnum%) THEN     'Right arrowπ                printcolumn% = printcolumn% + 1π                GOTO ed1π        END IFπ                                 '19 = Ctrl Sπ        IF (scan% = 75 OR scan% = 19) AND printcolumn% > column%(itemnum%) THEN          'Left arrowπ                printcolumn% = printcolumn% - 1π                GOTO ed1π        END IFππ        IF scan% = 79 THEN                                  'end for    End of textπ                IF LEN(RTRIM$(item$(itemnum%))) = 0 THENπ                        printcolumn% = column%(itemnum%) + itemlen%(itemnum%) - 1π                ELSEπ                        printcolumn% = column%(itemnum%) + LEN(RTRIM$(item$(itemnum%)))π                        IF printcolumn% > column%(itemnum%) + itemlen%(itemnum%) - 1 THEN printcolumn% = column%(itemnum%) + itemlen%(itemnum%) - 1π                END IFπ        GOTO ed1π        END IFππ        IF scan% = 99 THEN            'centre text on lineππ                lenitm% = LEN(LTRIM$(RTRIM$(item$(itemnum%))))ππ                item$(itemnum%) = SPACE$((itemlen%(itemnum%) - lenitm%) \ 2) + LTRIM$(RTRIM$(item$(itemnum%)))π                item$(itemnum%) = item$(itemnum%) + SPACE$(itemlen%(itemnum%) - LEN(item$(itemnum%)))π                        LOCATE row%(itemnum%), column%(itemnum%), 1, sc1%, sc2%π                        PRINT item$(itemnum%);ππ                scan% = 80π        END IFπππ        IF scan% = 117 THEN                                   'ctrl +  end to go to end of lineπ                printcolumn% = column%(itemnum%) + itemlen%(itemnum%) - 1π                GOTO ed1π        END IFππ        IF scan% = 71 THEN                                  ' Home to beginning of textπ                IF LEN(RTRIM$(item$(itemnum%))) = 0 THENπ                        printcolumn% = column%(itemnum%)π                ELSEπ                        printcolumn% = column%(itemnum%) + ((itemlen%(itemnum%)) - (LEN(LTRIM$(item$(itemnum%)))))π                        IF printcolumn% < column%(itemnum%) THEN printcolumn% = column%(itemnum%)π                END IFπ                GOTO ed1π        END IFππ        IF scan% = 119 THEN                             'ctrl + home to start of lineπ                printcolumn% = column%(itemnum%)π                GOTO ed1π        END IFππ        IF (scan% = 80 OR scan% = 24) OR (scan% = 13 AND itemnum% <> numentry%) THEN  'Down Arrow  or Enter for next fieldππ                itemnum% = itemnum% + 1π                        IF itemnum% > numentry% THEN itemnum% = numentry%π                                printcolumn% = column%(itemnum%)π                                GOTO ed1π                        END IFπ      ππ        IF scan% = 81 THEN                             ' pgdn to last lineπ                itemnum% = numentry%π                printcolumn% = column%(itemnum%)π                GOTO ed1π        END IFππ        IF scan% = 72 OR scan% = 5 THEN                      'Up Arrowπ                itemnum% = itemnum% - 1π                IF itemnum% < 1 THEN itemnum% = 1π                printcolumn% = column%(itemnum%)π                GOTO ed1π        END IFππ        IF scan% = 73 THEN                                 'pgup to top lineπ                itemnum% = 1π                printcolumn% = column%(itemnum%)π                GOTO ed1π        END IFππ        IF scan% = 83 THEN                                  'Deleteπ                item$(itemnum%) = LEFT$(item$(itemnum%), printcolumn% - column%(itemnum%)) + MID$(item$(itemnum%), printcolumn% - column%(itemnum%) + 2, itemlen%(itemnum%) - printcolumn% + column%(itemnum%) - 1) + " "π                LOCATE row%(itemnum%), column%(itemnum%), 1, sc1%, sc2%π                PRINT item$(itemnum%);π                GOTO ed1π        END IFπππ        IF scan% = 96 THEN                                  ' control f3 to delete lineπ                item$(itemnum%) = SPACE$(itemlen%(itemnum%))π                printcolumn% = column%(itemnum%)π                LOCATE row%(itemnum%), column%(itemnum%), 1, sc1%, sc2%π                PRINT item$(itemnum%);π                GOTO ed1π        END IFππ        IF scan% = 97 THEN                           'Ctrl F4 to copyπ                cutline$ = item$(itemnum%)π                GOTO ed1π        END IFππ        IF scan% = 98 THEN                                   'Ctrl F5 to pasteπ                item$(itemnum%) = cutline$π                LOCATE row%(itemnum%), column%(itemnum%), 1, sc1%, sc2%π                PRINT LEFT$(item$(itemnum%), itemlen%(itemnum%));π                GOTO ed1π        END IFππ        IF scan% = 82 THEN                                     'insert toggleπ                IF insertkey% = 0 THENπ                        insertkey% = 1π                        sc1% = 4       'change to 1/2 block cursorπ                        sc2% = 7π                ELSEπ                        insertkey% = 0π                        sc1% = 6π                        sc2% = 7π                END IFπ                GOTO ed1π         END IFππ         IF scan% = 103 THEN         'ctrl f10 to exitπ                scan% = 13π         END IFπ      πed3:π        IF scan% <> 13 THEN GOTO ed1ππ        FOR entry% = 1 TO numentry%                   'get rid of any ascii 0'sπ        tempstring$ = ""π                FOR leng% = 1 TO LEN(item$(entry%))π                        defaultstr$ = MID$(item$(entry%), leng%, 1)π                        IF ASC(defaultstr$) = 0 THEN defaultstr$ = " "π                        tempstring$ = tempstring$ + defaultstr$π                NEXT leng%π        item$(entry%) = RTRIM$(tempstring$)π        NEXT entry%πLOCATE , , 0       'turn off cursorπCOLOR sfg%, sbg%ππEND SUBππFUNCTION Justify$ (text$, just%, winleft%, winright%)πREM   function to justify text on a line within a windowπREM   text$ is the string to be modifiedπREM   just% = one of the followingπREM   0 = not justiiedπREM   1 = left justifiedπREM   2 = centre justifiedπREM   3 = right justifiedπREM   winleft% = the leftmost column of the windowπREM   winright% = the rightmost column of the windowππSELECT CASE just%π    CASE 0π        'nothing needs to be doneπ    CASE 1π        text$ = LTRIM$(text$)    'delete leading spacesπ    CASE 2π        centretext$ = LTRIM$(RTRIM$(text$))π        IF LEN(centretext$) MOD 2 <> 0 THEN centretext$ = centretext$ + " "π        lenitm% = LEN(centretext$) 'strip leading & trailing spaces and find length of remaining textπ        text$ = SPACE$(((winright% - winleft%) - lenitm%) \ 2) + centretext$  'add proper number of spaces to centre the textπ    CASE 3π        lenitm% = LEN(LTRIM$(RTRIM$(text$))) 'find length of text with leading & trailing spaces deletedπ        text$ = SPACE$((winright% - winleft%) - (lenitm% + 1)) + LTRIM$(RTRIM$(text$)) 'add proper number of spaces before the text so that text is right justifiedπEND SELECTππJustify$ = text$  'change justify$ to modified stringππEND FUNCTIONππSUB WindowSub (wintop%, winbot%, winleft%, winright%, winforecolour%, winbackcolour%, wintext$(), winborder%)πREM     wintop% & winbot% are the top & bottom rows of the windowπREM     winleft% & winright% are the left & right coloumns of the windowπREM     fbg% 'window background colourπREM     winforecolour% 'window foreground colourπREM     wintext$() is an array containing the text of each line in the windowπREM     winborder% is a flag which signals the program to add a border(frame) around the windowπREM         0 = no border, 1 = borderππfbg% = winbackcolour% 'window background colourπffg% = winforecolour% 'window foreground colourπ π        'set up 2 dimensional array to store characters "under" the windowπ        DIM charascii%(wintop% TO winbot%, winleft% TO winright%)ππ        'same as above but to store color attributesπ        DIM charattrib%(wintop% TO winbot%, winleft% TO winright%)ππ        FOR winline% = wintop% TO winbot%π            FOR wincolumn% = winleft% TO winright%π                charascii%(winline%, wincolumn%) = SCREEN(winline%, wincolumn%)     'fill character arrayπ                charattrib%(winline%, wincolumn%) = SCREEN(winline%, wincolumn%, 1)  'fill attribute arrayπ            NEXT wincolumn%π        NEXT winline%π        π            textline% = 1π            FOR winline% = wintop% TO winbot%         'put in window filled withπ                LOCATE winline%, winleft% + 1         'spaces of background colourπ                COLOR winforecolour%, winbackcolour%π                PRINT SPACE$(winright% - winleft%);π                LOCATE winline%, winleft% + 1π                PRINT wintext$(textline%);            'print text in windowπ                textline% = textline% + 1π            NEXT winline%ππ        IF winborder% = 1 THEN CALL Frame(wintop%, winbot%, winleft%, winright%)  'add fram if desiredππ        pause$ = INPUT$(1)    'pause ofter window is completeππ        FOR winline% = wintop% TO winbot%               'delete window and replaceπ           FOR wincolumn% = winleft% TO winright%       'original screenπ                LOCATE winline%, wincolumn%π                COLOR charattrib%(winline%, wincolumn%) MOD 16, (charattrib%(winline%, wincolumn%) AND &H70) \ 16  'parse stored colour attributes to foreground and backgroundπ                PRINT CHR$(charascii%(winline%, wincolumn%))   'print stored charactersπ            NEXT wincolumn%π        NEXT winline%ππERASE wintext$         'get the arrays out of memoryπERASE charascii%πERASE charattrib%ππEND SUBππPeter Norton                   ASCII TABLE                    DOS World                      11/95 (00:00)          QB, QBasic, PDS        130  3715     ASCII.BAS   'filename:  ascii.basπ'author:    Peter Norton - Felton, CAπ'source:    _DOS World_ number 24, Nov.1995, pp 53-54π'for:       QBasic 1.xππ'====================================================+π' Note: Please extract ASCII.BAT from the bottom of  |π' this file and place it in it's own file before     |π' running this program. This program is invoked with |π' ASCII.BAT, so put it in a directory in your PATH   |π' and edit the line that calls ASCII.BAS to reflect  |π' where you put it, so that it will be found.        |π'====================================================+ππDECLARE SUB chart ()πDECLARE SUB special (code!)πDECLARE SUB decode (code!)ππDEF SEG = &HB800            'video segment address for pokesπcode$ = ENVIRON$("ASCII")   'variable set in batch fileπcode = VAL(code$)π    COLOR 14, 1π    IF code$ = "" THEN chart    'print chart and exitπ    special code            'print special meaningπ    IF code THEN decode code    'decode if numberπ    IF LEN(code$) = 1 THENπ        code = ASC(code$)π        decode code         'decode if single characterπ    END IFπ    IF code = 0 THENπ        PRINT " Invalid parameter - "; code$;π        SHELL "ASCII /?"    'print usage messageπ    END IFπSYSTEMππ'--------------8<-----cut here----->8----------------ππSUB chartπ    CLSπ    A = 3                   'a = cursor position for POKEπ    FOR i = 1 TO 9          'i = ASCII codeπ        PRINT i; SPACE$(4);π        POKE A * 2, i       'position * 2 for attributesπ        A = A + 7π    NEXT iπ    A = A + 1π    FOR i = 10 TO 99π        PRINT i; SPACE$(3);π        POKE A * 2, iπ        A = A + 7π        IF i MOD 11 = 0 THEN A = A + 3  'advance at end of lineπ    NEXT iπ    A = A + 1π    FOR i = 100 TO 255π        PRINT i; SPACE$(2);π        POKE A * 2, iπ        A = A + 7π        IF i MOD 11 = 0 THEN A = A + 3π    NEXT iπ    COLOR 15π    PRINT "     Press any key to continue...";π    DOπ        LOOP WHILE INKEY$ = ""π    PRINTπ    SYSTEMπEND SUBππSUB decode (code)π    PRINT " Character "; CHR$(34); " "; CHR$(34);π    POKE (((CSRLIN - 1) * 80) + (POS(0) - 3)) * 2, codeπ    PRINT " ="; code; "Decimal, ";π    hexvalue$ = HEX$(code)π    IF LEN(hexvalue$) = 1 THEN hexvalue$ = "0" + hexvalue$π    PRINT hexvalue$; " Hexadecimal"πEND SUBππSUB special (code)π    SELECT CASE codeπ        CASE IS = 7π            PRINT " Beep (Bell)";π        CASE IS = 8π            PRINT " Backspace";π        CASE IS = 9π            PRINT " Tab";π        CASE IS = 10π            PRINT " Line feed";π        CASE IS = 12π            PRINT " Page eject";π        CASE IS = 13π            PRINT " Carriage return";π        CASE IS = 26π            PRINT " End of file";π        CASE IS = 27π            PRINT " Escape";π        CASE IS = 32π            PRINT " Space";π    END SELECTπEND SUBππ-----8<-------- ASCII.BAT --------------π@echo offπecho.πecho For advice on using this batch file,πecho type: ASCII /?πecho.πif %1!==/?! goto helpπ: topπset ascii=%1ππREM ====Edit the following line====πqbasic /run \basic\ascii.basπREM ======Edit the above line=====ππset ascii=πif %2!==! goto endπshiftπGOTO topπ: helpπecho.πecho Syntax: %0 [codes...] [characters...]πecho You may include any number of characters and codes,πecho separating them with spaces, commas, or semicolons.πecho.πecho You may provide letter or number keys, decimal or hexadecimalπecho numbers, and key combinations such as Ctrl+A. But you mustπecho precede hex numbers with &h or &H (for example, &H0A).πecho.πecho If you type ASCII at the DOS prompt, the program printsπecho the entire ASCII chart on screen.π: ENDπChristy Gemmell                PATHNAME OF CURRENT PROGRAM    PATHNAME,CURRENT,PROGRAM       Unknown Date           VBDOS                  68   3576     PATHNAME.BAS'  > Does anyone know how to find the directory a program was runπ'  > from, from inside that program? I hate the idea of hard codingπ'  > the directory names into the program as a poor solution...ππ'The function below will do it. I've tested it with DOS and Windows95π'and it works fine.  Be aware, though, that it will only work properlyπ'in a stand-alone program. If you run it in the IDE it returns theπ'path of VBDOS.EXE.ππ'--- cut here ----------------------------------------------------------------π' PATHNAME.BAS  demonstrates function to extract the pathname of theπ'               current program.π'π'   Author:     Christy Gemmellπ'π'  $INCLUDE: 'vbdos.bi'π'π    DECLARE FUNCTION PathName$ (ProgName$)ππ    A$ = PathName$(B$)π    PRINT A$, B$πENDππ'   Returns the directory path from where the current program wasπ'   launched. Also extracts the program filename.π'πFUNCTION PathName$ (ProgName$)π    DIM Regs AS RegType                         ' To hold register valuesπ    Regs.ax = &H6200                            ' DOS Service 98π    INTERRUPT &H21, Regs, Regs                  '  - find PSP segmentπ    DEF SEG = Regs.bx                           ' Segment of current programπ    EnvSeg& = PEEK(&H2C) + PEEK(&H2D) * 256&    ' Get environment pointerπ    DEF SEG = EnvSeg&                           ' Environment segmentπ    I% = 0                                      ' Shuffleπ    DO                                          '   throughπ       DO                                       '     environmentπ          ThisByte% = PEEK(I%)                  '       stringsπ          I% = I% + 1                           '         lookingπ       LOOP WHILE ThisByte%                     '           for twoπ       ThisByte% = PEEK(I%)                     '             successiveπ       I% = I% + 1                              '               nullπ    LOOP WHILE ThisByte%                        '                 bytesπ    I% = I% + 2                                 ' Skip over some junkπ    ProgName$ = ""                              ' To hold the program nameπ    DO                                          ' Readπ       ThisByte% = PEEK(I%)                     '   eachπ       IF ThisByte% THEN                        '     characterπ          ProgName$ = ProgName$ + CHR$(ThisByte%)  '    of programπ       END IF                                   '         name untilπ       I% = I% + 1                              '           we findπ    LOOP WHILE ThisByte%                        '             null byteπ    DEF SEG                                     ' Restore default segmentπ    L% = LEN(ProgName$)                         ' Did we find anything?π    IF L% THEN                                  ' If soπ       DO                                       '   scanπ          C$ = MID$(ProgName$, L%, 1)           '     backwardsπ          IF C$ = "\" THEN EXIT DO              '       lookingπ          L% = L% - 1                           '         for theπ       LOOP WHILE L%                            '           pathπ    END IF                                      '             delimiterπ    IF L% THEN                                  ' Seperateπ       PathName$ = LEFT$(ProgName$, L%)         '   directoryπ       ProgName$ = MID$(ProgName$, L% + 1)      '     pathπ    ELSE                                        '       fromπ       PathName$ = ""                           '         programπ    END IF                                      '           nameπEND FUNCTIONππChristy Gemmell                READ HARD DRIVE BOOT SECTOR    READ,HARD,DRIVE,BOOT,SECTOR    07-04-95 (00:00)       VBDOS                  109  4095     BOOTSEC.BAS ' BOOTSEC.BAS   reads the hard drive boot sector into memory.π'π'   Author:     Christy Gemmellπ'   Additions:  Martin Overtonπ'               David Miltonπ'   Date:       4/7/1995π'π'   $INCLUDE: 'VBDOS.BI'π'π    DECLARE SUB BootSex (Drive$, ParTable%, Done%)ππ    CONST FALSE = 0, TRUE = NOT FALSEππ    DIM SHARED Regs AS RegTypeXπ    DIM SHARED Sector AS STRING * 512π    DIM SHARED Part AS STRING * 512ππ    CLS : PRINT : Drive$ = "C:"         ' Read from drive C:π    BootSex Drive$, ParTable%, Done%    ' Read boot sectorπ    IF Done% THEN                       ' If successful...π       PRINT "Boot Sector for Drive "; Drive$π       PRINT "========================"π       PRINT "Media descriptor  = "; HEX$(ASC(MID$(Sector, 22, 8)))π       PRINT "OEM Identifier    = "; MID$(Sector, 4, 8)π       PRINT "Volume label      = "; MID$(Sector, 44, 11)π       PRINT "Serial number     = ";π       FOR I% = 43 TO 40 STEP -1π               PRINT RIGHT$("0" + HEX$(ASC(MID$(Sector, I%, 1))), 2);π               IF I% = 42 THEN PRINT "-";π       NEXT I%π       PRINT : PRINT "File system       = "; MID$(Sector, 55, 8)π       PRINTπ       IF ParTable% THENπ              PRINT "Partition Table for Drive "; Drive$π              PRINT "============================"π              I% = 447: P% = 1π              DOπ                     PRINT "Partition"; P%;π                     IF ASC(MID$(Part, I%, 1)) = 128 THENπ                            PRINT TAB(21); "ACTIVE PARTITION";π                     END IFπ                     OS% = ASC(MID$(Part, I% + 4, 1))π                     PRINT TAB(41);π                     SELECT CASE OS%π                             CASE 0π                                      PRINT "Empty"π                             CASE 1π                                      PRINT "DOS 12-bit FAT"π                             CASE 4π                                      PRINT "DOS 16-bit FAT (up to 32MB)"π                             CASE 5π                                      PRINT "Extended partition"π                             CASE 6π                                      PRINT "16-bit FAT (over 32MB)"π                             CASE 7π                                      PRINT "OS/2 HPFS or Windows NTFS"π                             CASE ELSEπ                                      PRINTπ                     END SELECTπ                     I% = I% + 16: P% = P% + 1π              LOOP UNTIL P% > 4π              PRINTπ              Sig& = ASC(MID$(Part, I%, 1)) + (256& * ASC(MID$(Part, I% + 1, 1)))π              IF Sig& = 43605 THENπ                     PRINT "Valid boot block"π              END IFπ       END IFπ       PRINT "-----------------------------------------------------------"π    END IFπENDππ'   Read the boot sector and partition table of a specified drive.π'πSUB BootSex (Drive$, ParTable%, Done%)π    LSET Sector = STRING$(512, 0)       ' Fill sector buffer with zeroesπ    Disk% = ASC(UCASE$(Drive$)) - 65    ' Get drive numberπ    Head% = 0                           ' Floppies use head zeroπ    IF Disk% > 1 THEN                   ' Adjustπ       Disk% = (Disk% + 128) - 2        '   for hardπ       Head% = 1                        '     diskπ    END IF                              '       drivesπ    Regs.cx = &H1                       ' Get sector 1 of track zeroπ    Regs.dx = (Head% * 256) + Disk%     '   of selected driveπ    Regs.ax = &H201                     ' Read one full sectorπ    Regs.bx = VARPTR(Sector)            ' Offset of read bufferπ    Regs.es = VARSEG(Sector)            ' Segment of read bufferπ    INTERRUPTX &H13, Regs, Regs         ' Read sector into memoryπ    IF Regs.flags AND 1 THEN            ' Test carry flag for errorπ       Done% = FALSE                    ' If set report an errorπ    ELSE                                ' Otherwiseπ       IF Disk% > 1 THEN                ' Hard driveπ              LSET Part = STRING$(512, 0)   ' Fill partition buffer with zeroesπ              Head% = 0                     ' Partition table is under head zeroπ              Regs.cx = &H1                 ' Get sector 1 of track zeroπ              Regs.dx = (Head% * 256) + Disk% ' of selected driveπ              Regs.ax = &H201               ' Read one full sectorπ              Regs.bx = VARPTR(Part)        ' Offset of read bufferπ              Regs.es = VARSEG(Part)        ' Segment of read bufferπ              INTERRUPTX &H13, Regs, Regs   ' Read sector into memoryπ              IF Regs.flags AND 1 THEN      ' Test carry flag for errorπ                 ParTable% = FALSE          ' If set report failureπ              ELSE                          ' Otherwiseπ                 ParTable% = TRUE           ' Report successπ              END IFπ       END IFπ       Done% = TRUE                     ' report successπ    END IFπEND SUBππ 1         205  CALCULATOR FUNCTIONS           Unknown Author(s)               3951      1047 METRIC CONVERTER               Unknown Author(s)               21744     175  VISUAL QUICK SORT              Ethan Winer                     25460     279  PB FORMULA SOLVER              Jamshid Khoshrangi              1         82   ANSI VIEWER                    Unknown Author(s)               3089      1165 PB ANSI-DRIVER                 Jamshid Khoshrangi              1         66   SIEVE OF ERATOSTHENES          Damond Walker                   1695      116  DRAW BOX DEMO                  Phil Wright                     4195      127  MENU IN A BOX                  Kenneth W. Melvin               7743      82   ASCII CHARACTER TABLE          Kenneth W. Melvin               1         296  COMPLETE MODE X ROUTINES       Matt Pritchard                  19378     30   SMOOTH TEXT VERTICAL SCROLL    The ABC Programmer              20480     34   MEMCOPY ROUTINE                Ethan Winer                     1         1198 POSTIT! 7.2 SCRIPT CODER       Rich Geldreich/Victor Yiu       1         87   CALCULATES DAY OF THE WEEK     Garry Spencer                   2428      85   HOW MANY DAYS                  Chris Tracy                     4858      62   UNIVERSAL TIME ZONE FINDER     Zachary Becker                  7243      15   VISUAL CLOCK DISPLAY           Peter Norton                    7959      39   TIMER FUNCTIONS                Matt Pritchard                  1         749  NO BRAIN (LIKE HUGO) GAME      The ABC Programmer              21960     62   SPEED RACER DEMO               The ABC Programmer              1         80   FLOPPY DRIVE FUNCTIONS         Unknown Author(s)               2288      25   DISABLE/ENABLE DRIVE           Dave Navarro, Jr.               2855      64   DETECT IF DRIVE IS READY       Brian McLaughlin                4526      28   CMOS SAVE/RESTORE UTILITY      James Vahn                      5409      53   CD-ROM RECOGNITION             Francois Roy                    7332      43   REPORTS DISK INFORMATION       Dave Navarro, Jr.               1         205  GET/SET FILES DATE/TIME        Christy Gemmell                 7933      82   PDS DIR$ FUNCTION FOR QB       Dave Cleary                     10832     195  CHECK IF FILE EXISTS           Logan Ashby/Andy Thomas         16921     222  PARSE COMMAND LINE             J. Derek Lyons                  25455     78   EXPAND FILE HANDLES            Brian McLaughlin                28932     67   TRUNCATE FILE                  Unknown Author(s)               31546     73   PRUNE FILES AND DIRECTORY      Dave Navarro, Jr.               1         391  LOAD 16 COLOR PCX              Greg Turgeon                    11312     125  256 COLORS IN SCREEN 12        Duane Jahnke                    1         930  SORTING AND OTHER FAQS         Unknown Author(s)               35636     28   MAKING (QUICK) LIBRARIES       Unknown Author(s)               1         238  ARCADE WHEEL OF WEALTH         The ABC Programmer              15551     308  EGA CONNECT FOUR               The ABC Programmer              24010     665  X-WING FIGHTER                 George Blank                    58682     344  RPG GAME ENGINE                [e-mail]          81234     344  HANGMAN GAME                   Unknown Author(s)               89616     514  GAME OF 21 (BLACKJACK)         Douglas Hergert                 106881    449  SUPER STAR TREK                Ron Williams                    136152    294  PIPELINE REVISION              Christy Gemmell                 148084    199  PAPER-SCISSORS-ROCK GAME       Unknown Author(s)               152097    78   SIMPLE DICE GAME               Kurt Kuzba                      155140    118  ROOM GAME                      Mike Beckman                    157771    400  3D TIC-TAC-TOE                 Rez Beheshti                    170969    635  MAD MAD MAD MAZES              Frederick Volking               193053    172  JOYSTICK PADDLE WARS           The ABC Programmer              199461    1160 MASTERCODE                     Ken Sweet                       1         166  FAST SPRITE ROUTINE            Calvin French/Victor Yiu        5812      228  LED DISPLAYS                   Scott Pessoni                   15230     71   PB FADING ROUTINE              Dave Navarro, Jr.               17007     174  IMAGE MAKER                    Earl Montgomery                 27695     164  3D ROTATING CUBE               Joshua Dickerson                32725     101  VGA SCREEN CAPTURE TSR         Earl Montgomery                 39308     244  VGA CLIP EDITOR                Earl Montgomery                 46297     279  WINDOWS BITMAP VIEWER          Zabudsky Aaron Scott            55020     95   EARTHQUAKE EFFECT DEMO         The ABC Programmer              57854     293  SAVE/RESTORE GRAPHICS SCREENS  Matt Hart                       67447     208  PB GIF DECODER                 Dave Navarro, Jr.               72722     108  PB PCX DECODER                 Dave Navarro, Jr.               75357     448  3D CRAFT WITH COLOR            Brett Levin                     1         59   EXECUTING ANOTHER PROGRAM      Unknown Author(s)               1         35   DISABLE CTRL+BREAK             Daniel Trimble                  1595      16   SET CURSOR TYPEMATIC KEYRATE   Unknown Author(s)               2214      141  STUFF KEYBOARD BUFFER          Christy Gemmell                 7817      52   RETURNS KEY(S) PRESSED         Peter Norton                    9247      17   DISABLE/ENABLE KEYBOARD        Unknown Author(s)               9735      127  EDWARD LAM/BRENT ASHLEY        DISABLE PAUSE BUTTON            1         61   CHECK FOR EMS                  James Vahn                      2193      333  EXPANDED MEMORY ROUTINES       Unknown Author(s)               11520     160  DETECTING XMS                  Logan Ashby                     22205     210  PEEKS AND POKES                Don Watkins                     1         140  NODELIST READER AND COMPILER   Quinn Tyler Jackson             3626      1167 PRINT SOURCE CODE LISTING      Jane Griscti                    41799     123  CREATE/MODIFY DBF FILES        Ethan Winer                     49959     254  READ/WRITE LOTUS 123 FILES     Ethan Winer                     1         146  ACCESSING FOSSIL IN BASIC      Coridon Henshaw                 3245      18   DETECTING CARRIER              Unknown Author(s)               4155      109  ALARM ON CONNECTION            James Vahn                      6914      452  BBS DICE DOOR GAME             David Colston                   17763     348  QB FOSSIL ROUTINES             Bob Perkins                     1         352  GRAPHICAL MOUSE GRID           Unknown Author(s)               11902     70   MOUSE PAINT                    Chad Beck                       14180     232  MOUSE FUNCTIONS FOR QBASIC     Glen Blankenship                22227     114  TEXT MOUSE ROUTINES            Kurt Kuzba                      25241     119  MOUSE TESTER                   Chris Wagner                    1         201  GET/SET FILES DATE/TIME        Christy Gemmell                 8749      63   BSAVE SCREEN CAPTURE TSR       Walt Mayo                       11188     164  PB SUB/FUNCTION ORGANIZER      Tim Gerchmez                    14786     197  ANSI SCREEN CAPTURE TSR        Jamshid Khoshrangi              19801     223  CODE POINTER DEMONSTRATION     Jamshid Khoshrangi              25796     244  SWAP ARRAY DEMO                Jamshid Khoshrangi              32368     43   PANTA                          Jesu's Lozano                   1         150  SOUND CARD DETECTION           Brett Levin                     4649      22   PC SPEAKER FREQUENCY           James Vahn                      5498      21   TURN PC SPEAKER OFF            Unknown Author(s)               6294      63   WAV PLAYER                     Jos Szabo                       8543      128  SB NOTE PLAYER                 Jos Szabo                       12317     178  RPG MUSIC SAMPLES              Multiple Authors                17341     288  MUSIC COMPOSER                 Krisjanis Gale                  23997     67   WILLIAM TELL OVERTURE          Unknown Author(s)               28238     444  VOC TO SAMPLE DUMP STANDARD    Monte Ferguson                  1         1041 ULTIMATE TEXT VIEWER           The ABC Programmer              35718     61   SIMPLE BANNER SCROLL           The ABC Programmer              37391     50   EMULATES TYPING BLUNDERS       The ABC Programmer              38578     81   SCREEN DRAWING ROUTINES        Kenneth W. Melvin               41597     49   CONCATENATES ASCII TEXT        Jesu's Lozano                   43096     115  COMMATOR                       Jesu's Lozano                   47055     121  FULL STRING EDIT               Unknown Author(s)               52130     337  DUMP FILE TO SCREEN            Jim Giordano                    61785     90   PRINT HUGE CHARACTERS          Unknown Author(s)               64466     93   EDIT STRING IN BOX             Erik Olson                      67026     21   COPY A FILE                    John Sneeringer                 67848     165  LINE WRAPPING                  John White/Dan Bridges          72509     524  INPUT ROUTINES                 Bert Christensen                96592     130  ASCII TABLE                    Peter Norton                    1         68   PATHNAME OF CURRENT PROGRAM    Christy Gemmell                 3674      109  READ HARD DRIVE BOOT SECTOR    Christy Gemmell